packages feed

heddit (empty) → 0.0.1

raw patch · 77 files changed

+17108/−0 lines, 77 filesdep +aesondep +aeson-casingdep +basebinary-added

Dependencies added: aeson, aeson-casing, base, bytestring, case-insensitive, conduit, conduit-extra, config-ini, containers, exceptions, filepath, generic-lens, hashable, heddit, hspec, http-api-data, http-client, http-client-tls, http-conduit, http-types, microlens, microlens-ghc, microlens-platform, mtl, network, random, scientific, split, text, time, unliftio, unordered-containers, uri-bytestring

Files

+ CHANGELOG.org view
@@ -0,0 +1,4 @@+#+TITLE: CHANGELOG++* 0.0.1++ Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, Rory Tyler Hayford++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Rory Tyler Hayford nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.org view
@@ -0,0 +1,37 @@+#+TITLE: heddit++~heddit~ is a Reddit API client library for Haskell. It aims to be (almost) as comprehensive as libraries such as  [[https://github.com/praw-dev/praw][praw]], from which it takes major inspiration. Although it is not quite there, it does offer access to various parts of the Reddit API, including:+ - comments and submissions+ - user accounts and private messages+ - subreddits, wikis, collections, and emojis+ - live threads+ - moderation and various mod actions+ - ... and more++To start using ~heddit~, visit [[file:./doc/start.org][the (very) quick start guide]] or browse the haddocks in [[file:./src/Network][src/Network]]++*WARNING*: ~heddit~ is /definitely/ alpha-quality at the moment. Expect bugs, instability, and incomplete documentation for now!++* Table of Contents+- [[file:./doc/start.org][Quick start]]+- [[file:./doc/auth.org][Authenticating]]+- [[Caveats]]+- [[Examples]]+- [[Tests]]+- [[License]]++* Caveats+There are some major caveats to using ~heddit~ that you may want to consider before deciding to use it, namely:+- It is currently alpha quality. It needs more tests and users to work out some of the bugs that are assuredly lurking deep within. The exposed API is a little weird and may be difficult to work with.+- 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.++* Examples+I would like to add some more executable examples of how to use ~heddit~, particularly to demonstrate some of the weirder points of the API. At the moment, the available example programs are:+- Getting an initial [[file:./examples/RefreshTokens.hs][refresh token]]++* Tests+~heddit~ has two test suites: a simple test of JSON decoding of API responses that runs by default, and the ~io-tests~ that are disabled by default behind a flag of the same name. If you wish to run the ~io-tests~, be aware that these make real requests against Reddit's API endpoints using the authenticated account. After enabling the tests, make sure to create an ~auth.ini~ and ~profile.json~ in the working directory or in ~$XDG_CONFIG_HOME/heddit~. See the ~io-tests~ modules for more info.++* License+~heddit~ is distributed under a three-clause BSD license. See [[file:LICENSE][the license]] for details. Parts of this library are directly inspired by and/or adapted from ~praw~, which is distributed under a simplified BSD two-clause license. See [[https://github.com/praw-dev/praw/blob/master/LICENSE.txt]]
+ assets/haskell.png view

binary file changed (absent → 3256 bytes)

+ doc/auth.org view
@@ -0,0 +1,97 @@+#+TITLE: Authenticating with OAuth++~heddit~ only supports authenticating via OAuth. You can use any of the applications types that can be registered on Reddit:++    - [[#script][Scripts]]+    - [[#web][Web applications]]+    - [[#installed][Installed applications]]+    - [[#app-only][Application-only]]++The first three application types take a user context. If you do not wish to have a user context, you can create an ~ApplicationOnly~ app. You must first register your application on Reddit before using ~heddit~, even for ~ApplicationOnly~ apps.++Although Reddit supports alternative OAuth flows for each application type, ~heddit~ currently only supports the default flows detailed below.++In brief, [[#script][scripts]] and [[#app-only][application-only]] apps can use ~loadClient~ and ~newClient~ to create a Reddit client. [[#web][web]] and [[#installed][installed]] apps can use ~newClient~ in which case OAuth refresh tokens will be unmanaged and will not persist after the end of your program, or ~newClientWithManager~, which will manage the tokens when provided with a ~TokenManager~.++~heddit~ will automatically refresh access tokens when they are close to expiration.++You must also provide a unique ~UserAgent~ when creating your ~Client~, as the code snippets below assume.++* Scripts+:PROPERTIES:+:CUSTOM_ID: script+:END:++*Script apps* are the simplest application to configure and use, but also require providing your Reddit username and password. Your credentials will be kept in memory in the ~Client~ that is created, so if this is not desirable, consider using a different application type. There is no callback process with script apps.++To create a script app, you need to provide your:+    - *client ID*+    - *client secret*+    - *username*+    - *password*++At the moment, ~heddit~ supports two ways of creating new ~ScriptApps~. The first is directly provide the relevant details in ~newClient~, as so:+#+begin_src haskell+main :: IO ()+main = do+     c <- newClient myAuthConfig+     ...+  where+    myAuthConfig = AuthConfig myClientID myScriptApp myUA+    myScriptApp = ScriptApp myClientSecret myPWFlow+    myPWFlow = PasswordFlow myUsername myPassword+#+end_src++The second way is to store your credentials and other details in an ~auth.ini~ file and use ~loadClient~. See the details of [[file:../src/Network/Reddit.hs::loadClient][loadClient]] for the location and format of these files.++* Web applications+:PROPERTIES:+:CUSTOM_ID: web+:END:++*Web apps* use a ~CodeFlow~ and require configuring an OAuth callback to generate the auth tokens. The steps outlined below largely apply to [[#installed][installed apps]] as well. This flow has several benefits:+    - you want to access the Reddit accounts of your users from a web or installed application+    - you are using a script and do not want to store your username and password in memory+    - you want to use delimited scopes with your script application (using a [[#script][script app]] with a ~PasswordFlow~ implicitly grants all scopes)++If you are not actually running a web service, you can still create a ~WebApp~ by registering the correct application on Reddit and running [[file:../examples/RefreshTokens.hs][the RefreshTokens example program]] to get the initial token.++The first step in completing a ~CodeFlow~ is to provide a valid redirect URI when creating your application. This will be used to generate a URL that your users can visit to authorize your application, resulting in a single-use code that will be used to create your ~Client~, e.g.:++#+begin_src haskell+getURL :: MonadIO m => URL -> ClientID -> m URL+getURL myRedirectURL myClientID = do+     -- The state should be unique to each user. You can confirm that it matches when you+     -- extract the params from Reddit's response+     state <- T.pack . show <$> randomRIO @Int (0, 65000)+     pure $ getAuthURL myRedirectURI Permanent [ Read, Save, Vote, Accounts ] clientID state+#+end_src++See [[file:../src/Network/Reddit.hs::getAuthURL][getAuthURL]] for details.++Once you have your ~CodeFlow~ using the code and your redirect URL, you can use this to create a ~Client~. If you use ~newClient~, ~heddit~ will fetch the initial refresh token and exchange it for an access token. The tokens will be stored in the ~Client~ that you create, but if you do not store them, your users will need to complete the authentication flow again.++#+begin_src haskell+myNewClient :: (MonadUnliftIO m, MonadCatch m) => Code -> m Client+myNewClient code = newClient authConfig+  where+    authConfig = AuthConfig myClientID app myUserAgent+    app        = WebApp myClientSecret codeFlow+    codeFlow   = CodeFlow redirectURI code+#+end_src++An alternative is to use ~getAuthURL~ to obtain the code, then get the refresh token using a similar method to what is demonstrated in ~examples/RefreshTokens.hs~. After getting the refresh token, you can use [[file:../src/Network/Reddit.hs::newClientWithManager][newClientWithManager]] and provide ~heddit~ with a record of monadic actions that will load and store your tokens. See the [[file:../src/Network/Reddit.hs::fileTokenManager][fileTokenManager]] for a simple example.++* Installed applications+:PROPERTIES:+:CUSTOM_ID: installed+:END:++*Installed apps* are similar to [[#web][web]], but do not take a secret and also follow the ~CodeFlow~.++* Application-only+:PROPERTIES:+:CUSTOM_ID: app-only+:END:++If you do not wish to use your Reddit ~Client~ with a user context, create an ~ApplicationOnly~ app. The process is indentical to [[#script][scripts]], but you do not provide a ~PasswordFlow~ to create the ~Client~. ~ApplicationOnly~ apps may also use ~loadClient~ with an ~auth.ini~ file. NB: many endpoints will not work, so be prepared for exceptions when working within this context.
+ doc/start.org view
@@ -0,0 +1,97 @@+#+TITLE: Getting Started++The following is a brief guide to getting started with ~heddit~. It will cover what you should know in order to start using a script or bot application.++*Note*: For this guide, I'm using ~generic-lens~ with ~-XOverloadedLabels~ and a lens library to access record fields. You could also impor the selectors from the modules directly.++* Table of Contents+- [[Prerequisites]]+- [[Obtain a ~Client~]]+- [[Running actions]]+  + [[Me]]+  + [[Subreddits]]+- [[More]]++* Prerequisites+** Create a Reddit account+You must have an account with Reddit in order to use the API+** Register an application+First you must [[https://old.reddit.com/prefs/apps][register an application]] with Reddit. Make sure to select a "script" application and save the client secret and client ID+** Create a user agent+You must create a unique user agent to interface with the API. Reddit rate-limits and/or bans misleading or non-descript user agents. Use the ~UserAgent~ type to create yours, which is exported by default and looks like:+#+begin_src haskell+data UserAgent = UserAgent+    { -- | The target platform+      platform :: Text+      -- | A unique application ID+    , appID    :: Text+    , version  :: Text+      -- | Your username as contact information+    , author   :: Text+    }+#+end_src++* Obtain a ~Client~+The first step is to create a ~Client~. For the sake of brevity, we will use ~newClient~, but it would be more convenient to use ~loadClient~ in real code (which also does not require directly passing your Reddit username and password).++First, create a ~PasswordFlow~ with your real Reddit username and password:++#+begin_src haskell+myPWFlow = PasswordFlow "real-username" "password123"+#+end_src++This will be used to create the correct ~AppType~, a ~ScriptApp~ which also takes the client secret obtained from Reddit:++#+begin_src haskell+myScriptApp = ScriptApp "really-secret-reddit-client-secret" myPWFlow+#+end_src++Finally, these are both used to create an ~AuthConfig~ that will stored in the ~Client~ over the course of your program:++#+begin_src haskell+myAuthConfig = AuthConfig myClientID myScriptApp myUA+#+end_src++These config is given to ~newClient~ to initialize the client:++#+begin_src haskell+main :: IO ()+main = do+     c <- newClient myAuthConfig+     ...+  where+    ...+#+end_src++* Running actions+Now that you have a Client, we will use ~runReddit~ with the client to perform any of the ~MonadReddit~ actions in the library.++** Me+First, you can use the ~getMe~ action to see that you are authenticated as the correct user+#+begin_src haskell+main :: IO ()+main = do+    ...+    me <- runReddit c getMe+    print $ me ^. #username+    ...+#+end_src++You should see your Reddit username printed.++** Subreddits+You can get the information on a single ~Subreddit~ using ~getSubreddit~:+#+begin_src haskell+main :: IO ()+main = do+    ...+    subName <- mkSubredditName "haskell"+    haskellSub <- runReddit c $ getSubreddit subName+    print $ haskellSub ^. #title+    ...+#+end_src++Which should print the title of "r/haskell"++* More+Look at the haddocks, or check the [[file:../examples][examples]] directory, to see more examples of what you can do with ~heddit~
+ examples/RefreshTokens.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++-- | This small program demonstrates how to obtain an initial refresh token+-- to use with a 'WebApp' 'Client'. This is useful if you are not really running+-- a web server, but would like to use the \"code flow\" authentication process.+-- If successful, the program will print the refresh token at the end. You can+-- save this token and use it for later when creating a 'newClientWithManager'.+-- You must use this instead of 'newClient' in order to provide the initial+-- refresh token (otherwise, 'newClient' will try to use the authorization code+-- to get a brand-new refresh token).+--+-- The full steps to running this program are as follows:+--+--    1. If you haven't already:+--+--          * visit <https://www.reddit.com/prefs/apps/> while logged in+--          * create a new \"web app\" and set http:\/\/localhost:8080 as+--            the redirect URI+--          * save the client ID and client secret after creating the app+--+--    2. Export the environment variables @HEDDIT_CLIENT_ID@ and+--       @HEDDIT_CLIENT_SECRET@, corresponding to the values from Reddit,+--       and run the program+--+--    3. When prompted, enter the desired scopes. See the documentation+--       for 'Scope' for available values. All of the scope names are the+--       the same as the constructors, but lower-cased (except for 'Accounts',+--       which corresponds to \"account\"). You can also use the special+--       value \"*\" to request all scopes+--+--    4. After visiting the URL to authorize the application and granting+--       the requested scopes, you should be redirected to a page that+--       contains the refresh token. Save this and use it for later!+--+module RefreshTokens where++import           Control.Exception              ( bracket, throwIO )+import           Control.Monad++import           Data.Aeson                     ( eitherDecodeStrict )+import qualified Data.ByteString.Char8          as C8+import qualified Data.ByteString.Lazy.Char8     as LC8+import           Data.Generics.Labels           ()+import           Data.IORef+import qualified Data.Text                      as T+import           Data.Text                      ( Text )+import qualified Data.Text.Encoding             as T+import qualified Data.Text.IO                   as T++import           Lens.Micro.Platform++import           Network.Reddit+import           Network.Socket+import           Network.Socket.ByteString.Lazy ( recv, send )++import           System.Environment+import           System.Random++import           Web.FormUrlEncoded++main :: IO ()+main = do+    (clientID, clientSecret) <- getClientCredentials+    scopes <- getScopes+    state <- makeState+    T.putStrLn+        $ "Visit this URL in your browser: "+        <> getAuthURL redirectURI Permanent scopes clientID state++    socketClient <- receiveConnection+    recv socketClient 1024 <&> decodeParams >>= \case+        Nothing          -> throwIO+            $ InvalidResponse "Failed to decode query params in API response"+        Just (Form form) -> case traverse (getFormVal form)+                                          [ "code", "state" ] of+            Just [ code, s ] -> do+                when (state /= s) . throwIO+                    $ InvalidResponse "States do not match"+                let codeFlow   = CodeFlow redirectURI code+                    app        = WebApp clientSecret codeFlow+                    authConfig = AuthConfig clientID app ua+                token <- getRefreshToken authConfig+                sendMessage socketClient $ "Refresh token: " <> token+            _                ->+                throwIO $ InvalidResponse "Data missing from API response"+  where+    getFormVal form v = form ^? at v . _Just . _head++    ua = UserAgent "web" "refreshToken" "v0" "u/heddit-dev"++    redirectURI = "http://localhost:8080"++    getScopes = do+        T.putStrLn+            $ "Enter a comma-separated list of `Scope`s"+            <> " (e.g. `read,save,vote`), or `*` for all scopes"+        either (throwIO . userError) pure+            . traverse eitherDecodeStrict+            . fmap (quote . C8.strip)+            . C8.split ','+            =<< C8.getLine+      where+        quote x = "\"" <> x <> "\""++    makeState = T.pack . show <$> randomRIO @Int (0, 65000)++    getRefreshToken ac = do+        client <- newClient ac+        clientState <- readIORef $ client ^. #clientState+        case clientState ^. #accessToken . #refreshToken of+            Just token -> pure token+            Nothing    ->+                throwIO $ InvalidResponse "Failed to receive refresh token"++    getClientCredentials =+        (,) <$> getCred "HEDDIT_CLIENT_ID" <*> getCred "HEDDIT_CLIENT_SECRET"+      where+        getCred name = maybe (credError name) (pure . T.pack)+            =<< lookupEnv name++        credError name = throwIO . userError+            $ mconcat [ name+                      , " not found in environment."+                      , " Please `export $"+                      , name+                      , "=<VALUE>`"+                      , " before running this program"+                      ]++decodeParams :: LC8.ByteString -> Maybe Form+decodeParams txt = case LC8.words txt of+    _ : query : _ -> decodeQ =<< LC8.stripPrefix "/?" query+    _             -> Nothing+  where+    decodeQ = either (const Nothing) Just . urlDecodeForm++receiveConnection :: IO Socket+receiveConnection =+    getAddrInfo (Just hints) (Just "localhost") (Just "8080") >>= \case+        addr@AddrInfo { .. } : _ -> bracket (openSock addr) close $ \sock -> do+            setSocketOption sock ReuseAddr 1+            bind sock addrAddress+            listen sock 1+            (client, _) <- accept sock+            pure client+        [] -> throwIO $ OtherError "Failed to get socket address"+  where+    openSock AddrInfo { .. } = socket addrFamily Stream addrProtocol++    hints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }++sendMessage :: Socket -> Text -> IO ()+sendMessage sock msg = do+    T.putStrLn msg+    void . send sock+        $ mconcat [ "HTTP/1.1 200 OK\r\n\r\n"+                  , LC8.fromStrict $ T.encodeUtf8 msg+                  ]+    close sock
+ heddit.cabal view
@@ -0,0 +1,185 @@+cabal-version:      3.0+name:               heddit+version:            0.0.1+synopsis:           Reddit API bindings+description:        See the README at https://gitlab.com/ngua/heddit+license:            BSD-3-Clause+license-file:       LICENSE+author:             Rory Tyler Hayford+maintainer:         rory.hayford@protonmail.com+copyright:          (c) Rory Tyler Hayford, 2021+homepage:           https://gitlab.com/ngua/heddit+bug-reports:        https://gitlab.com/ngua/heddit/-/issues+category:           Network+tested-with:        GHC ==8.10.4+data-files:         assets/haskell.png+extra-doc-files:+  CHANGELOG.org+  doc/**/*.org+  README.org++extra-source-files:+  assets/haskell.png+  tests/data/**/*.json++source-repository head+  type:     git+  location: https://gitlab.com/ngua/heddit-hs.git++flag examples+  description: build the example executables+  default:     False++flag io-tests+  description: run the full IO tests+  default:     False++common common-options+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+    -Wmissing-deriving-strategies++common common-extensions+  default-extensions: OverloadedStrings++library+  import:           common-options, common-extensions+  hs-source-dirs:   src+  default-language: Haskell2010+  exposed-modules:+    Network.Reddit+    Network.Reddit.Comment+    Network.Reddit.Item+    Network.Reddit.Live+    Network.Reddit.Me+    Network.Reddit.Message+    Network.Reddit.Moderation+    Network.Reddit.Multireddit+    Network.Reddit.Submission+    Network.Reddit.Subreddit+    Network.Reddit.Types+    Network.Reddit.Types.Account+    Network.Reddit.Types.Comment+    Network.Reddit.Types.Emoji+    Network.Reddit.Types.Flair+    Network.Reddit.Types.Internal+    Network.Reddit.Types.Item+    Network.Reddit.Types.Live+    Network.Reddit.Types.Message+    Network.Reddit.Types.Moderation+    Network.Reddit.Types.Multireddit+    Network.Reddit.Types.Submission+    Network.Reddit.Types.Subreddit+    Network.Reddit.Types.Widget+    Network.Reddit.Types.Wiki+    Network.Reddit.User++  other-modules:+    Network.Reddit.Auth+    Network.Reddit.Internal+    Network.Reddit.Utils++  other-modules:    Paths_heddit+  autogen-modules:  Paths_heddit+  build-depends:+    , aeson                 ^>=1.5+    , aeson-casing          ^>=0.2+    , base                  >=4.11    && <5+    , bytestring            >=0.9+    , case-insensitive      >=1.0     && <1.3+    , conduit               ^>=1.3+    , conduit-extra         ^>=1.3+    , config-ini            ^>=0.2+    , containers            ^>=0.6+    , exceptions            ^>=0.10+    , filepath              ^>=1.4+    , generic-lens          >=1.1     && <2.2+    , hashable              >=1.0.1.1 && <1.4+    , http-api-data         ^>=0.4+    , http-client           >=0.5     && <0.8+    , http-client-tls       ^>=0.3.5+    , http-conduit          ^>=2.3+    , http-types            ^>=0.12+    , microlens             ^>=0.4.10+    , mtl                   ^>=2.2+    , random                >=1.1+    , scientific            ^>=0.3.6+    , split                 ^>=0.2.3+    , text                  ^>=1.2+    , time                  >=1.8     && <1.12+    , unliftio              ^>=0.2+    , unordered-containers  ^>=0.2.10+    , uri-bytestring        ^>=0.3++executable refresh-tokens+  import:           common-options, common-extensions+  hs-source-dirs:   examples++  if !flag(examples)+    buildable: False++  build-depends:+    , aeson               ^>=1.5+    , base                >=4.13  && <5+    , bytestring          >=0.9+    , generic-lens        >=1.1   && <2.2+    , heddit+    , http-api-data       ^>=0.4+    , microlens-platform  ^>=0.4.2+    , network             ^>=3.1+    , random              >=1.1+    , text                ^>=1.2++  main-is:          RefreshTokens.hs+  ghc-options:      -main-is RefreshTokens+  default-language: Haskell2010++test-suite tests+  import:           common-options, common-extensions+  type:             exitcode-stdio-1.0+  hs-source-dirs:   tests+  build-depends:+    , aeson         ^>=1.5+    , base          >=4.13   && <5+    , bytestring    >=0.9+    , containers    ^>=0.6+    , generic-lens  >=1.1    && <2.2+    , heddit+    , hspec         >=2.0    && <3.0+    , microlens     ^>=0.4.10++  main-is:          Main.hs+  default-language: Haskell2010++test-suite io-tests+  import:           common-options, common-extensions+  type:             exitcode-stdio-1.0++  if !flag(io-tests)+    buildable: False++  hs-source-dirs:   io-tests+  build-depends:+    , aeson          ^>=1.5+    , base           >=4.13   && <5+    , containers     ^>=0.6+    , generic-lens   >=1.1    && <2.2+    , heddit+    , hspec          >=2.0    && <3.0+    , microlens-ghc  ^>=0.4.10+    , text           ^>=1.2+    , time           >=1.8    && <1.12+    , unliftio       ^>=0.2++  other-modules:+    CommentSpec+    LiveSpec+    MeSpec+    Profile+    SubmissionSpec+    SubredditSpec+    UserSpec++  main-is:          Spec.hs+  default-language: Haskell2010
+ io-tests/CommentSpec.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++module CommentSpec ( spec ) where++import           Data.Generics.Labels ()+import           Data.Sequence        ( Seq((:<|)) )+import           Data.Time++import           Lens.Micro.GHC++import           Network.Reddit++import           Test.Hspec++spec :: Spec+spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.Comment"+    $ sequence_ [ single, multiple, replies, saveUnsave, loadMore ]++single :: SpecWith Client+single = it "gets a single comment" $ \c -> do+    comment <- runReddit c . getComment $ CommentID "dmdwy0x"+    username <- mkUsername "GreenEyedFriend"+    subname <- mkSubredditName "haskell"+    comment ^. #author `shouldBe` username+    comment ^. #created `shouldBe` read @UTCTime "2017-08-31 17:40:15 +0000"+    comment ^. #subreddit `shouldBe` subname+    comment ^. #edited `shouldBe` Nothing+    comment ^. #linkID `shouldBe` SubmissionID "6x7ms0"++multiple :: SpecWith Client+multiple = it "gets multiple comments" $ \c -> do+    comments <- runReddit c . getComments defaultItemOpts+        $ CommentID <$> [ "dmdwy0x", "dmdr4ji" ]+    case comments of+        c1 :<| c2 :<| _ -> do+            author1 <- mkUsername "GreenEyedFriend"+            author2 <- mkUsername "semanticistZombie"+            c1 ^. #author `shouldBe` author1+            c2 ^. #author `shouldBe` author2+        _               ->+            expectationFailure "Failed to fetch multiple comments"++replies :: SpecWith Client+replies = it "gets child comments" $ \c -> do+    noReplies <- runReddit c . getComment $ CommentID "dmdwy0x"+    noReplies ^. #replies `shouldBe` mempty+    hasReplies <- runReddit c $ withReplies defaultItemOpts noReplies+    case hasReplies ^? #replies . each . #_TopLevel of+        Nothing      -> expectationFailure "Failed to load child comments"+        Just comment -> do+            username <- mkUsername "MagicMurderBagYT"+            comment ^. #author `shouldBe` username+            (comment ^.. #replies . each . #_TopLevel . #commentID)+                `shouldContain` [ CommentID "dme9869" ]++saveUnsave :: SpecWith Client+saveUnsave = it "saves and unsaves comments" $ \c -> do+    runReddit c $ saveComment commentID+    saved <- runReddit c $ firstPage getMySaved+    case saved ^? each . #_CommentItem of+        Nothing      -> expectationFailure "Failed to save comment"+        Just comment -> do+            username <- mkUsername "Apterygiformes"+            comment ^. #commentID `shouldBe` commentID+            comment ^. #author `shouldBe` username+            comment ^. #body `shouldBe` "Haha oh no"+            comment ^. #score `shouldSatisfy` maybe True (< 0)++            runReddit c $ unsaveComment commentID+            saved2+                <- runReddit c . getMySaved $ emptyPaginator & #limit .~ 100+            (saved2 ^.. #children . each . #_CommentItem . #commentID)+                `shouldNotContain` [ commentID ]+  where+    commentID = CommentID "dme1kf9"++loadMore :: SpecWith Client+loadMore = it "loads more child comments" $ \c -> do+    children <- runReddit c $ getChildComments submissionID+    case children ^? each . #_More of+        Nothing   ->+            expectationFailure "Failed to get collapsed submission comments"+        Just more -> do+            more ^. #count `shouldBe` 207+            loaded <- runReddit c+                $ loadMoreComments (Just 1) defaultItemOpts submissionID more+            case loaded ^.. each . #_TopLevel of+                [ comment ] -> do+                    username <- mkUsername "i_pk_pjers_i"+                    comment ^. #author `shouldBe` username+                    case loaded ^? each . #_More of+                        Just more2 -> more2 ^. #count `shouldBe` 206+                        _          -> loadFailed+                _           -> loadFailed+  where+    submissionID = SubmissionID "aeufh6"++    loadFailed   =+        expectationFailure "Loaded the wrong number of child comments"
+ io-tests/LiveSpec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++module LiveSpec ( spec ) where++import           Data.Generics.Labels ()+import           Data.Time++import           GHC.Exts             ( fromList )++import           Lens.Micro.GHC++import           Network.Reddit+import           Network.Reddit.Live++import           Test.Hspec++spec :: Spec+spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.Live"+    $ sequence_ [ liveThread, contributors, updates, excess, discussions ]++liveThread :: SpecWith Client+liveThread = it "gets a livethread" $ \c -> do+    thread <- runReddit c . getLiveThread $ LiveThreadID "ta40l9u2ermf"+    thread ^. #title `shouldBe` "[Live] Test, please don't upvote."+    thread ^. #created `shouldBe` read @UTCTime "2014-07-23 17:07:51 +0000"+    thread ^. #liveState `shouldBe` Complete+    thread ^. #nsfw `shouldBe` False+    thread ^. #websocketURL `shouldBe` Nothing++contributors :: SpecWith Client+contributors = it "gets livethread contributors" $ \c -> do+    cs <- runReddit c . getLiveContributors $ LiveThreadID "ta40l9u2ermf"+    case cs ^? _head of+        Just contributor -> do+            (contributor ^. #permissions) `shouldBe` fromList [ Update ]+            contributor ^. #userID `shouldBe` UserID "bji9w"+        _                -> expectationFailure "Failed to get contributors"++updates :: SpecWith Client+updates = it "gets livethread updates" $ \c -> do+    us <- runReddit c . firstPage . getLiveUpdates+        $ LiveThreadID "ta40l9u2ermf"+    case us ^? _head of+        Just update -> do+            username <- mkUsername "pokoleo"+            update ^. #author `shouldBe` Just username+            update ^. #body `shouldBe` "Woah, this still exists"+            update ^. #stricken `shouldBe` False+        _           -> expectationFailure "Failed to get updates"++excess :: SpecWith Client+excess = it "gets livethread info in excess of API limit" $ \c -> do+    threads <- runReddit c . getAllLiveInfo+        $ LiveThreadID <$> replicate 101 "ta40l9u2ermf"+    length threads `shouldBe` 101++discussions :: SpecWith Client+discussions = it "gets livethread discussions" $ \c -> do+    ds <- runReddit c+        $ getLiveDiscussions (LiveThreadID "11e4mknpbhjqr") emptyPaginator+    (ds ^. #children & length) `shouldBe` 4
+ io-tests/MeSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++module MeSpec ( spec ) where++import           Data.Either+import           Data.Generics.Labels ()++import           Lens.Micro.GHC++import           Network.Reddit++import           Profile++import           Test.Hspec++spec :: Spec+spec = beforeAll loadClientAndProfile . describe "Network.Reddit.Me"+    $ sequence_ [ account, multireddits, karma, friends ]++account :: SpecWith (Client, TestProfile)+account = it "gets the current user" $ \(c, profile) -> do+    me <- runReddit c getMe+    me ^. #username `shouldBe` profile ^. #username+    me ^. #userID `shouldBe` profile ^. #userID++multireddits :: SpecWith (Client, TestProfile)+multireddits = it "gets the current user's multireddits" $ \(c, _) -> do+    ms <- tryReddit @APIException c getMyMultireddits+    ms `shouldSatisfy` isRight++karma :: SpecWith (Client, TestProfile)+karma = it "gets the current user's karma" $ \(c, _) -> do+    ms <- tryReddit @APIException c getMyKarma+    ms `shouldSatisfy` isRight++friends :: SpecWith (Client, TestProfile)+friends = it "gets the current user's friends" $ \(c, _) -> do+    ms <- tryReddit @APIException c getMyFriends+    ms `shouldSatisfy` isRight++loadClientAndProfile :: IO (Client, TestProfile)+loadClientAndProfile = (,) <$> loadClient Nothing <*> loadProfile
+ io-tests/Profile.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++module Profile ( loadProfile, TestProfile(TestProfile) ) where++import           Data.Aeson         ( FromJSON(parseJSON)+                                    , defaultOptions+                                    , eitherDecodeFileStrict+                                    , genericParseJSON+                                    )++import           GHC.Generics       ( Generic )++import           Network.Reddit++import           UnliftIO+import           UnliftIO.Directory++-- | Info on the authenticated user you are running the tests as+data TestProfile = TestProfile+    { username  :: Username+    , userID    :: UserID+      -- | You must be a moderator on this subreddit+    , subreddit :: SubredditName+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON TestProfile where+    parseJSON = genericParseJSON defaultOptions++-- | Load the test profile from disk+loadProfile :: MonadUnliftIO m => m TestProfile+loadProfile = do+    cwd <- getCurrentDirectory+    cfgDir <- getXdgDirectory XdgConfig "heddit"+    findFile [ cwd, cfgDir ] "profile.json" >>= \case+        Nothing -> throwIO . userError+            $ mconcat [ "No profile.json found for running tests"+                      , " , please create on in $PWD"+                      , " or $XDG_CONFIG_HOME/heddit"+                      ]+        Just f  -> either (throwIO . userError) pure+            =<< liftIO (eitherDecodeFileStrict @TestProfile f)
+ io-tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ io-tests/SubmissionSpec.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++-- |+module SubmissionSpec ( spec ) where++import           Data.Generics.Labels ()+import           Data.Sequence        ( Seq((:<|)) )+import           Data.Time++import           Lens.Micro.GHC++import           Network.Reddit++import           Test.Hspec++{- HLINT ignore "Redundant do"-}+spec :: Spec+spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.Submission"+    $ sequence_ [ single, multiple, excess, none, hideUnhide ]++single :: SpecWith Client+single = it "gets a single submission by URL" $ \c -> do+    submission <- runReddit c+        $ getSubmissionByURL "https://reddit.com/comments/6x7ms0/"+    author <- mkUsername "ysangkok"+    subreddit <- mkSubredditName "haskell"++    submission ^. #author `shouldBe` author+    submission ^. #content `shouldBe` content+    submission ^. #title `shouldBe` title+    submission ^. #subreddit `shouldBe` subreddit+    submission ^. #numComments `shouldBe` 41+    submission ^. #submissionID `shouldBe` SubmissionID "6x7ms0"+    submission+        ^. #created `shouldBe` read @UTCTime "2017-08-31 15:42:20 +0000"+  where+    content = ExternalLink+        $ mconcat [ "https://bartoszmilewski.com/"+                  , "2014/10/28/"+                  , "category-theory-for-programmers-the-preface/"+                  ]++    title   = mconcat [ "\"Category Theory for Programmers\" "+                      , "has been finished!"+                      ]++multiple :: SpecWith Client+multiple = it "gets multiple submissions" $ \c -> do+    submissions <- runReddit c . getSubmissions defaultItemOpts+        $ SubmissionID <$> [ "50389g", "eume40" ]+    case submissions of+        s1 :<| s2 :<| _ -> do+            s1 ^. #title `shouldBe` "Resignation"+            s2 ^. #title `shouldBe` "One Haskell IDE to rule them all"+        _               ->+            expectationFailure "Failed to fetch multiple submissions"++excess :: SpecWith Client+excess = it "gets submissions in excess of API limit" $ \c -> do+    submissions <- runReddit c . getSubmissions defaultItemOpts+        $ SubmissionID <$> replicate 101 "50389g"+    length submissions `shouldBe` 101++none :: SpecWith Client+none = it "gracefully gets no submissions with empty container" $ \c -> do+    submissions <- runReddit c $ getSubmissions defaultItemOpts []+    submissions `shouldBe` mempty++hideUnhide :: SpecWith Client+hideUnhide =+    -- This is rather fragile way of testing this functionality. It /appears/+    -- that newly hidden items are always put at the front of the list in the+    -- API endpoint for hidden things+    it "hides and unhides submissions" $ \c -> do+        let getHidden = runReddit c $ firstPage getMyHidden+            sid       = SubmissionID "4kdzp2"++        runReddit c $ hideSubmission sid+        hidden1 <- getHidden <&> (^? _head . #_SubmissionItem . #submissionID)+        hidden1 `shouldBe` Just sid+        runReddit c $ unhideSubmission sid+        hidden2 <- getHidden <&> (^.. each . #_SubmissionItem . #submissionID)+        hidden2 `shouldNotContain` [ sid ]
+ io-tests/SubredditSpec.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++module SubredditSpec ( spec ) where++import           Data.Foldable        ( traverse_ )+import           Data.Generics.Labels ()+import           Data.Time++import           Lens.Micro.GHC++import           Network.Reddit++import           Test.Hspec++spec :: Spec+spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.Submission"+    $ sequence_ [ getInfo+                , getTop+                , nameSearch+                , userFlair+                , missingFlair+                , submissionFlair+                , widgets+                , emojis+                , wikipages+                , collections+                , revisions+                ]++getInfo :: SpecWith Client+getInfo = it "gets subreddit info" $ \c -> do+    haskellSub <- mkSubredditName "haskell"+    subreddit <- runReddit c $ getSubreddit haskellSub++    subreddit ^. #name `shouldBe` haskellSub+    subreddit ^. #subredditID `shouldBe` SubredditID "2qh36"+    subreddit ^. #over18 `shouldBe` False+    subreddit ^. #quarantine `shouldBe` False+    subreddit ^. #created `shouldBe` read @UTCTime "2008-01-25 06:37:23 +0000"++getTop :: SpecWith Client+getTop = it "gets the top all-time submission" $ \c -> do+    let opts      = defaultItemOpts & #itemTime ?~ AllTime+        paginator = emptyPaginator & (#limit .~ 1) . (#opts .~ opts)+    haskellSub <- mkSubredditName "haskell"+    listing <- runReddit c $ getTopSubmissions haskellSub paginator+    case listing ^? #children . _head of+        Nothing  -> expectationFailure "Failed to get top submission"+        Just top -> top ^. #submissionID `shouldBe` SubmissionID "6x7ms0"++nameSearch :: SpecWith Client+nameSearch = it "searches subreddits by name" $ \c -> do+    results <- runReddit c $ searchSubredditsByName Nothing Nothing "haskell"+    names <- traverse mkSubredditName [ "haskell", "haskellquestions" ]+    traverse_ (shouldContain (results ^.. each) . pure) names++userFlair :: SpecWith Client+userFlair = it "gets user flair templates" $ \c -> do+    flairTemplates+        <- runReddit c $ getUserFlairTemplates =<< mkSubredditName "linux"+    case flairTemplates ^? _head of+        Nothing    -> expectationFailure "Failed to get flair templates"+        Just flair -> do+            flairText <- mkFlairText ":linux:"+            flair ^. #text `shouldBe` flairText+            flair ^. #textEditable `shouldBe` False+            flair ^. #textColor `shouldBe` Just Dark+            flair ^. #allowableContent `shouldBe` AllContent++missingFlair :: SpecWith Client+missingFlair =+    it "throws the correct exception if user flair is not allowed" $ \c -> do+        let action = getUserFlairTemplates =<< mkSubredditName "haskell"+            ex     = \case+                ErrorWithStatus (StatusMessage 403 "Forbidden") -> True+                _ -> False+        runReddit c action `shouldThrow` ex++submissionFlair :: SpecWith Client+submissionFlair = it "gets new submission flair choices" $ \c -> do+    haskellSub <- mkSubredditName "haskell"+    choices <- runReddit c (getNewSubmissionFlairChoices haskellSub)+    case choices ^? _head of+        Nothing    -> expectationFailure "Failed to get flair choices"+        Just flair -> do+            flairText <- mkFlairText "announcement"+            flair ^. #text `shouldBe` flairText+            flair ^. #textEditable `shouldBe` False+            flair ^. #cssClass `shouldBe` Nothing++widgets :: SpecWith Client+widgets = it "gets subreddit widgets" $ \c -> do+    ws <- runReddit c $ getSubredditWidgets =<< mkSubredditName "haskell"++    let idCard = ws ^. #idCard+        idcID  = WidgetID "id-card-2qh36"+    idcName <- mkShortName "Community Details"+    idCard ^. #widgetID `shouldBe` Just idcID+    idCard ^. #shortName `shouldBe` idcName++    let mods     = ws ^. #moderators+        modsID   = WidgetID "moderators-2qh36"+        modNames = mods ^.. #mods . each . #name+    dons <- mkUsername "dons"+    mods ^. #widgetID `shouldBe` Just modsID+    modNames `shouldContain` [ dons ]++emojis :: SpecWith Client+emojis = it "gets subreddit emojis" $ \c -> do+    es <- runReddit c $ getSubredditEmojis =<< mkSubredditName "linux"+    emojiName <- mkEmojiName "nix"+    case es ^? each . filtered ((== emojiName) . (^. #name)) of+        Nothing    -> expectationFailure "Failed to get subreddit emojis"+        Just emoji -> do+            emoji ^. #modFlairOnly `shouldBe` False+            emoji ^. #postFlairAllowed `shouldBe` True+            emoji ^. #userFlairAllowed `shouldBe` True+            emoji ^. #createdBy `shouldBe` Just (UserID "den0g")++wikipages :: SpecWith Client+wikipages = it "gets subreddit wiki pages" $ \c -> do+    pages <- runReddit c $ getWikiPages =<< mkSubredditName "linux"+    pages ^.. each `shouldContain` [ mkWikiPageName "index" ]++revisions :: SpecWith Client+revisions = it "gets wiki page revisions" $ \c -> do+    let pageName  = mkWikiPageName "index"+        paginator = emptyPaginator & #limit .~ 1+    linuxSub <- mkSubredditName "linux"+    revs <- runReddit c $ getWikiPageRevisions linuxSub pageName paginator+    case revs ^? #children . _head of+        Nothing  -> expectationFailure "Failed to get wiki page revisions"+        Just rev -> do+            page <- runReddit c . getWikiPageRevision linuxSub pageName+                $ rev ^. #revisionID++            rev ^. #author `shouldBe` page ^. #revisionBy++collections :: SpecWith Client+collections = it "gets subreddit collections" $ \c -> do+    pages <- runReddit c $ getWikiPages =<< mkSubredditName "linux"+    pages ^.. each `shouldContain` [ mkWikiPageName "index" ]
+ io-tests/UserSpec.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeApplications #-}++module UserSpec ( spec ) where++import           Data.Generics.Labels ()+import           Data.Time++import           Lens.Micro.GHC++import           Network.Reddit++import           Test.Hspec++spec :: Spec+spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.User"+    $ sequence_ [ users, trophies, submissions, summaries, searches ]++users :: SpecWith Client+users = it "gets a user" $ \c -> do+    user <- runReddit c $ getUser =<< mkUsername "edwardkmett"+    user ^. #userID `shouldBe` UserID "26009"+    user ^. #created `shouldBe` read @UTCTime "2007-07-13 07:11:06 +0000"+    user ^. #commentKarma `shouldSatisfy` (> 50000)+    user ^. #linkKarma `shouldSatisfy` (> 6000)++trophies :: SpecWith Client+trophies = it "gets a user's trophies" $ \c -> do+    ts <- runReddit c $ getUserTrophies =<< mkUsername "edwardkmett"+    case ts ^? each . filtered ((Just "4" ==) . (^. #awardID)) of+        Nothing     -> expectationFailure "Failed to get correct user trophies"+        Just trophy -> do+            trophy ^. #name `shouldBe` "Best Comment"+            trophy ^. #trophyID `shouldBe` Just "y35z3"++submissions :: SpecWith Client+submissions = it "gets a user's submissions" $ \c -> do+    let opts      = defaultItemOpts+            & (#itemTime ?~ AllTime) . (#itemSort ?~ Top)+        paginator = emptyPaginator & (#limit .~ 1) . (#opts .~ opts)+    username <- mkUsername "bgamari"+    ss <- runReddit c $ getUserSubmissions username paginator+    case ss ^? #children . _head of+        Nothing         -> expectationFailure "Failed to get user ss"+        Just submission -> do+            submission ^. #submissionID `shouldBe` SubmissionID "4kdzp2"+            submission ^. #numComments `shouldBe` 124++summaries :: SpecWith Client+summaries = it "gets user summaries" $ \c -> do+    account <- runReddit c $ getUser =<< mkUsername "edwardkmett"+    summary <- runReddit c . getUserSummary $ account ^. #userID+    summary ^. #userID `shouldBe` Just (UserID "26009")+    summary ^. #commentKarma `shouldSatisfy` (> 50000)+    summary ^. #linkKarma `shouldSatisfy` (> 6000)+    summary ^. #profileColor `shouldBe` Nothing+    summary ^. #profileOver18 `shouldBe` False++searches :: SpecWith Client+searches = it "searches users by name" $ \c -> do+    results <- runReddit c . firstPage $ searchUsers "edwardkmett"+    case results ^? _head of+        Nothing -> expectationFailure "Failed to search users"+        Just u  -> do+            username <- mkUsername "edwardkmett"+            u ^. #username `shouldBe` username
+ src/Network/Reddit.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      : Network.Reddit+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit+    ( newClient+    , newClientWithManager+    , loadClient+    , getAuthURL+    , runReddit+    , runRedditT+    , tryReddit+    , getRateLimits+    , withRateLimitDelay+    , fileTokenManager+      -- * Actions+    , firstPage+    , nextPage+    , emptyPaginator+    , stream+      -- * Basic types+    , MonadReddit+    , RedditT+    , Client(Client)+    , RateLimits(RateLimits)+    , Listing(Listing)+    , Paginator(Paginator)+    , ItemOpts(ItemOpts)+    , defaultItemOpts+    , ItemSort(..)+    , ItemReport(ItemReport)+    , Distinction(..)+    , Time(..)+    , ItemType(..)+    , UploadURL+    , Body+    , Title+    , URL+    , Subject+    , RGBText+    , Name+    , Domain+    , Modifier+      -- ** Exceptions+    , RedditException+    , ClientException(..)+    , APIException(..)+    , OAauthError(OAauthError)+    , ErrorMessage(..)+    , StatusMessage(StatusMessage)+    , StatusCode+    , JSONError(JSONError)+      -- * Auth+    , ClientState+    , AppType(..)+    , AuthConfig(AuthConfig)+    , UserAgent(UserAgent)+    , AccessToken(AccessToken)+    , Token+    , Code+    , Scope(..)+    , PasswordFlow(PasswordFlow)+    , CodeFlow(CodeFlow)+    , ClientID+    , ClientSecret+    , TokenDuration(..)+      -- * Re-exports+      -- | Only modules covering basic functionality are re-exported,+      -- including those for users, subreddits, submissions, comments,+      -- and actions for the authenticated user. For actions and types+      -- touching on moderation, collections, live threads, and more,+      -- import the respective modules directly+    , module M+    ) where++import           Conduit+                 ( (.|)+                 , ConduitT+                 , decodeUtf8LenientC+                 , encodeUtf8C+                 , mapC+                 , runConduit+                 , runConduitRes+                 , sinkFile+                 , sinkLazy+                 , sourceLazy+                 , withSourceFile+                 , yieldMany+                 )++import           Control.Monad.Catch+                 ( Exception+                 , MonadCatch(catch)+                 , MonadThrow(throwM)+                 , try+                 )+import           Control.Monad.Reader++import           Data.Bool+import           Data.Generics.Product     ( HasField(field) )+import           Data.Maybe+import           Data.Sequence             ( Seq(Empty, (:<|)) )+import qualified Data.Sequence             as Seq+import qualified Data.Text                 as T+import qualified Data.Text.Lazy            as LT+import           Data.Time.Clock.POSIX++import           Lens.Micro++import           Network.HTTP.Client.TLS   ( newTlsManager )+import           Network.Reddit.Auth+import           Network.Reddit.Comment    as M+import           Network.Reddit.Me         as M+import           Network.Reddit.Submission as M+import           Network.Reddit.Subreddit  as M+import           Network.Reddit.Types+import           Network.Reddit.User       as M+import           Network.Reddit.Utils++import           System.Random++import           UnliftIO                  ( MonadUnliftIO )+import           UnliftIO.Concurrent       ( threadDelay )+import           UnliftIO.IORef++import           Web.FormUrlEncoded        ( ToForm(toForm) )++-- | Create a new 'Client' for API access, given an 'AuthConfig'. This client is+-- required to run all actions in this library.+--+-- See 'loadClient' if you have a 'ScriptApp' or 'ApplicationOnly' app and would+-- like to load your auth details from an ini file+newClient :: (MonadUnliftIO m, MonadThrow m) => AuthConfig -> m Client+newClient ac =+    Client ac <$> newTlsManager <*> (newIORef =<< newState) <*> pure Nothing+  where+    newState = ClientState <$> getAccessToken toForm ac+        <*> liftIO getPOSIXTime+        <*> pure Nothing++-- | Create a new client with an existing refresh token, for 'WebApp's and+-- 'InstalledApp's. The initial refresh token is provided with a 'TokenManager'+-- that will also handle saving and loading refresh tokens over the life of+-- the new 'Client'+newClientWithManager :: (MonadUnliftIO m, MonadCatch m)+                     => TokenManager+                     -> AuthConfig+                     -> m Client+newClientWithManager mgr@TokenManager { .. } ac = Client ac <$> newTlsManager+    <*> (newIORef =<< newState)+    <*> pure (Just mgr)+  where+    newState = do+        token <- flip getAccessTokenWith ac =<< loadToken+        putToken $ token ^. field @"refreshToken"+        ClientState token <$> liftIO getPOSIXTime <*> pure Nothing++-- | Load a client from saved credentials, which are stored in an ini file. Files+-- should conform to the following formats:+--+-- For 'ScriptApp's:+--+-- > [NAME]+-- > id = <clientID>+-- > secret = <clientSecret>+-- > username = <username>+-- > password = <password>+-- > agent = <platform>,<appID>,<version>,<author>+--+-- For 'ApplicationOnly' apps without a user context:+--+-- > [NAME]+-- > id = <clientID>+-- > secret = <clientSecret>+-- > agent = <platform>,<appID>,<version>,<author>+--+-- Where NAME corresponds to a 'ClientSite' that you pass to this function.+-- You can have various different distinct sites in a single ini file. When+-- invoking this function, if the provided client site is @Nothing@, a section+-- labeled @[DEFAULT]@ will be used. If none is provided, an exception will be+-- thrown. Note that all section labels are case-insensitive.+--+-- The following locations are searched for an ini file, in order:+--+--      * $PWD\/auth.ini+--      * $XDG_CONFIG_HOME\/heddit\/auth.ini+--+-- __Note__: Only 'ScriptApp's and 'ApplicationOnly' are supported via this method+loadClient :: (MonadUnliftIO m, MonadThrow m) => Maybe ClientSite -> m Client+loadClient cs = newClient =<< loadAuthConfig (fromMaybe "default" cs)++-- | Run an action with your Reddit 'Client'. This will catch any exceptions+-- related to POST rate-limiting for you. After sleeping for the indicated+-- duration, it will attempt to re-run the action that triggered the exception.+-- If you do not wish to catch these exceptions, or would like to handle them+-- in a different way, use 'runRedditT', which simply runs the provided action+--+-- __Note__: Confusingly, Reddit uses /two/ different rate-limiting mechanisms.+-- This action only catches rate limiting applied to POST requests. Another form+-- of rate limiting is applied to API requests in general. This library does not+-- automatically deal with this second type. If you wish to deal with this+-- yourself, see the action 'withRateLimitDelay', which automatically applies a+-- delay based on the most recent rate limit headers returned from Reddit+runReddit :: (MonadCatch m, MonadIO m) => Client -> RedditT m a -> m a+runReddit client action =+    catch @_ @APIException (runRedditT client action) $ \case+        ErrorWithMessage (Ratelimited duration _) -> do+            threadDelay $ fromInteger duration * 1000000+            runReddit client action+        e -> throwM e++-- | Run an action with your Reddit 'Client', catching the exception specified and+-- returning an @Either@ in case of failure. It may be best to use @TypeApplications@+-- to specify the exception type.+--+-- For example, to try to see the user 'FlairTemplate's for a subreddit which may or+-- may not allow user flair:+--+-- >>> tryReddit @APIException c $ getUserFlairTemplates =<< mkSubredditName "haskell"+-- Left (ErrorWithStatus (StatusMessage {statusCode = 403, message = "Forbidden"}))+--+tryReddit :: forall e a m.+          (Exception e, MonadCatch m, MonadIO m)+          => Client+          -> RedditT m a+          -> m (Either e a)+tryReddit c = try @_ @e . runReddit c++-- | Convenience wrapper for actions taking a 'Paginator' and which return a+-- 'Listing'. This runs the action with a default initial paginator, and extracts+-- the @children@ from the returned 'Listing'. This discards all of the pagination+-- controls that are returned in the @Listing@. This is useful if you only care+-- about the child contents of the first \"page\" of results+--+-- For example, to get only the first page of results for a user's comments,+-- you could use the following:+--+-- > runReddit yourClient . firstPage $ getUserComments someUsername+--+firstPage :: (MonadReddit m, Paginable a)+          => (Paginator t a -> m (Listing t a))+          -> m (Seq a)+firstPage f = f emptyPaginator <&> (^. field @"children")++-- | Update a 'Paginator' with a 'Listing' to make a query for the next \"page\"+-- of content. If the first argument is @Nothing@, defaults will be used for+-- the options, partially depending on the type of paginator+--+-- __Note__: You cannot supply both the @before@ and @after@ fields when making+-- requests to API endpoints. If both fields are @Just@ in the @Paginator@ you+-- get back from this function, the @after@ field will take precedence. If you+-- want to use @before@ in such a scenario, make sure to set it to @Nothing@+-- before using the paginator in an action+--+-- Example:+--+-- >>> best1 <- runReddit yourClient $ getBest emptyPaginator+-- >>> best2 <- runReddit yourClient . getBest $ nextPage Nothing best1+--+nextPage :: forall t a.+         Paginable a+         => Maybe (Paginator t a)+         -> Listing t a+         -> Paginator t a+nextPage (Just p) Listing { .. } = p { before, after }+nextPage (const (emptyPaginator @t @a) -> p) -- Default paginator+         Listing { .. } = p { before, after }++-- | Get current information on rate limiting, if any+getRateLimits :: MonadReddit m => m (Maybe RateLimits)+getRateLimits = readClientState $ field @"limits"++-- | Run the provided 'MonadReddit' action with a delay, if rate-limiting+-- information is currently available+withRateLimitDelay :: MonadReddit m => m a -> m a+withRateLimitDelay action = getRateLimits >>= \case+    Nothing                -> action+    Just RateLimits { .. } -> do+        now <- liftIO getPOSIXTime+        let duration = nextRequest - now+            sleep    = threadDelay $ round duration * 1000000+        bool (pure ()) sleep $ duration > 0+        action++-- | 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+-- first. New items are fetched in 100-item batches. If nothing new arrives in+-- the stream, a jittered exponential backoff is applied, up to a cap of ~16s,+-- resetting once new items arrive again.+--+-- For example, to fetch new submissions published to \"r/haskell\", as they+-- are created, and print their IDs to the console:+--+-- >>> import Conduit+-- >>> subName <- mkSubredditName "haskell"+-- >>> action = getNewSubmissions subName+-- >>> printTitle = liftIO . print . (^. #title)+-- >>> runReddit c . runConduit $ stream Nothing action  .| mapM_C printTitle+-- SubmissionID "o6948i"+-- SubmissionID "o6b0w0"+-- SubmissionID "o6cqof"+-- SubmissionID "o6ddl9"+-- SubmissionID "o6dlas"+-- ...+--+stream :: forall m t a.+       ( MonadReddit m  --+       , Paginable a+       , t ~ PaginateThing a+       )+       => Maybe Bool+       -- ^ When @True@, will only yield items that have+       -- newly arrived, thus skipping items from the first+       -- request that already existed+       -> (Paginator t a -> m (Listing t a))+       -> ConduitT () a m ()+stream (fromMaybe False -> skip) action =+    go skip 1 emptyPaginator { limit = 100 }+  where+    go :: Bool -> Double -> Paginator t a -> ConduitT i a m b+    go skipInit n paginator = do+        Listing { children } <- lift $ action paginator+        case children of+            Empty   -> do+                (delay, nextBase) <- backoff n+                threadDelay . round $ delay * 1000000+                go False nextBase paginator { after = Nothing }+            t :<| _ -> do+                bool (yieldMany $ Seq.reverse children) (pure ()) skipInit+                go False+                   1+                   paginator+                   { before = Just $ getFullname t --+                   , after  = Nothing+                   }++    backoff base = do+        jitter <- randomIO @Double+        pure ( base + jitter * maxJitter - maxJitter / 2+             , min (base * 2) maxBase+             )+      where+        maxJitter = base / 16++        maxBase   = 16++-- | This is an example 'TokenManager' that can be used to store and retrieve+-- OAUth refresh tokens, which could be used with 'newClientWithManager'. For+-- a real application, you would probably want to use a more sophisticated+-- manager+fileTokenManager+    :: Exception e+    => e+    -- ^ An exception that will be thrown when Reddit doesn\'t return a+    -- new refresh token+    -> FilePath -- ^ The location of the stored tokens+    -> TokenManager+fileTokenManager e fp = TokenManager load put+  where+    load :: MonadIO m => m Token+    load = liftIO . withSourceFile @_ @IO fp $ \b -> LT.toStrict+        <$> runConduit (b .| decodeUtf8LenientC .| mapC T.strip .| sinkLazy)++    put :: (MonadIO m, MonadThrow m) => Maybe Token -> m ()+    put = maybe (throwM e) writeToken+      where+        writeToken rt = liftIO . runConduitRes+            $ sourceLazy (LT.fromStrict rt) .| encodeUtf8C .| sinkFile fp
+ src/Network/Reddit/Auth.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Auth+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Authentication via OAuth for the Reddit API+module Network.Reddit.Auth+    ( loadAuthConfig+    , getAccessToken+    , getAccessTokenWith+    , getAuthURL+    , redditURL+    , oauthURL+    , refreshAccessToken+    ) where++import           Conduit+                 ( (.|)+                 , decodeUtf8LenientC+                 , runConduit+                 , sinkLazy+                 , withSourceFile+                 )++import           Control.Monad.Catch         ( MonadThrow(throwM) )+import           Control.Monad.Reader        ( asks )++import           Data.Aeson                  ( decode, eitherDecode )+import           Data.ByteString             ( ByteString )+import qualified Data.ByteString.Lazy        as LB+import qualified Data.CaseInsensitive        as CI+import           Data.Conduit.Binary         ( sinkLbs )+import           Data.Foldable               ( asum )+import           Data.Function               ( on )+import           Data.Generics.Product       ( HasField(field) )+import           Data.Ini.Config             ( IniParser )+import qualified Data.Ini.Config             as Ini+import qualified Data.Text                   as T+import           Data.Text                   ( Text )+import qualified Data.Text.Encoding          as T+import qualified Data.Text.Lazy              as LT++import           Lens.Micro++import           Network.HTTP.Client.Conduit ( Request+                                             , RequestBody(RequestBodyLBS)+                                             )+import qualified Network.HTTP.Client.Conduit as H+import           Network.HTTP.Simple         ( withResponse )+import           Network.Reddit.Types+import           Network.Reddit.Utils++import           UnliftIO                    ( MonadUnliftIO )+import           UnliftIO.Directory++import           Web.FormUrlEncoded          ( toForm, urlEncodeAsFormStable )+import           Web.HttpApiData             ( ToHttpApiData(toQueryParam) )+import           Web.Internal.FormUrlEncoded ( Form )++-- | Load the auth file, looking in the following locations, in order:+--+--      * $PWD\/auth.ini+--      * XDG_CONFIG_HOME\/heddit\/auth.ini+--+-- __Note__: Only 'ScriptApp's and 'ApplicationOnly' apps are supported+loadAuthConfig+    :: (MonadUnliftIO m, MonadThrow m) => ClientSite -> m AuthConfig+loadAuthConfig cs = do+    cwDir <- getCurrentDirectory+    cfgDir <- getXdgDirectory XdgConfig "heddit"+    findFile [ cfgDir, cwDir ] "auth.ini" >>= \case+        Nothing -> throwM . OtherError+            $ mconcat [ "No auth.ini file found in the current directory"+                      , " or $XDG_CONFIG_HOME/heddit, please create one"+                      ]+        Just fp -> parseAuthIni cs fp++parseAuthIni :: forall m.+             (MonadUnliftIO m, MonadThrow m)+             => ClientSite+             -> FilePath+             -> m AuthConfig+parseAuthIni cs fp = withSourceFile @_ @m fp $ \b ->+    either (throwM . userError) pure+    . flip Ini.parseIniFile (authConfigP cs)+    . LT.toStrict+    =<< runConduit (b .| decodeUtf8LenientC .| sinkLazy)++authConfigP :: Text -> IniParser AuthConfig+authConfigP sec = asum [ scriptP, appOnlyP ]+  where+    appOnlyP = Ini.section sec+        $ AuthConfig <$> Ini.field "id"+        <*> (ApplicationOnly <$> Ini.field "secret")+        <*> Ini.fieldOf "agent" uaP++    scriptP  = Ini.section sec+        $ AuthConfig <$> Ini.field "id"+        <*> (ScriptApp <$> Ini.field "secret"+             <*> (PasswordFlow <$> Ini.field "username"+                  <*> Ini.field "password"))+        <*> Ini.fieldOf "agent" uaP++uaP :: Text -> Either [Char] UserAgent+uaP t = case T.splitOn "," t of+    [ platform, appID, version, author ] -> Right UserAgent { .. }+    _ -> Left+        $ mconcat [ "User agent must be of the form"+                  , " '<platform>,<appID>,<version>,<author>'"+                  ]++-- | Get the URL required to authorize your application, for 'WebApp's and+-- 'InstalledApp's+getAuthURL+    :: Foldable t+    => URL+    -- ^ A redirect URI, which must exactly match the one+    -- registered with Reddit when creating your application+    -> TokenDuration+    -> t Scope+    -- ^ The OAuth scopes to request authorization for+    -> ClientID+    -> Text+    -- ^ Text that is embedded in the callback URI when the+    -- client completes the request. It must be composed+    -- of printable ASCII characters and should be unique+    -- for the client+    -> URL+getAuthURL redirectURI duration scopes clientID state =+    T.decodeUtf8 $ "https://" <> mconcat pieces+  where+    pieces  = [ H.host, H.path, H.queryString ] <*> [ request ]++    query   = LB.toStrict . urlEncodeAsFormStable+        $ mkTextForm [ ("client_id", clientID)+                     , ("duration", toQueryParam duration)+                     , ("redirect_uri", redirectURI)+                     , ("response_type", "code")+                     , ("state", state)+                     , ("scope", joinParams scopes)+                     ]++    request = H.defaultRequest+        { H.host        = redditURL+        , H.path        = joinPathSegments [ "api", "v1", "authorize" ]+        , H.queryString = "?" <> query+        }++-- | Generate an 'AccessToken' from an 'AuthConfig'. This serves to create an+-- initial token for all 'AppType's, and can also be used to refresh tokens for+-- 'ScriptApp's and 'ApplicationOnly' apps+getAccessToken :: (MonadUnliftIO m, MonadThrow m)+               => (AppType -> Form)+               -> AuthConfig+               -> m AccessToken+getAccessToken f ac@AuthConfig { .. } =+    makeTokenRequest . setUAHeader ac =<< request appType+  where+    request   = \case+        sa@(ScriptApp clientSecret _)     ->+            applyAuth clientID clientSecret <$> mkReq sa+        ro@(ApplicationOnly clientSecret) ->+            applyAuth clientID clientSecret <$> mkReq ro+        wa@(WebApp clientSecret _)        ->+            applyAuth clientID clientSecret <$> mkReq wa+        ia@InstalledApp {}                ->+            H.applyBasicAuth (T.encodeUtf8 clientID) mempty <$> mkReq ia++    applyAuth = H.applyBasicAuth `on` T.encodeUtf8++    mkReq     = routeToRequest . mkAuthRoute . f++getAccessTokenWith+    :: (MonadUnliftIO m, MonadThrow m) => Token -> AuthConfig -> m AccessToken+getAccessTokenWith rt AuthConfig { .. } = case appType of+    ScriptApp {}          -> cfgError+    ApplicationOnly {}    -> cfgError+    WebApp clientSecret _ ->+        makeTokenRequest . applyAuth clientID clientSecret =<< mkReq+    InstalledApp {}       ->+        makeTokenRequest . applyAuth clientID mempty =<< mkReq+  where+    mkReq                = routeToRequest . mkAuthRoute+        $ mkTextForm [ ("grant_type", "refresh_token")+                     , ("refresh_token", rt)+                     ]++    applyAuth cid secret = (H.applyBasicAuth `on` T.encodeUtf8) cid secret++    cfgError             = throwM+        $ ConfigurationError "getAccessTokenWith: unsupported application type"++makeTokenRequest+    :: forall m. (MonadUnliftIO m, MonadThrow m) => Request -> m AccessToken+makeTokenRequest req = withResponse @_ @m req $ \resp -> do+    bodyBS <- runConduit $ (resp & H.responseBody) .| sinkLbs+    case eitherDecode bodyBS of+        Right token -> pure token+        Left err    -> case decode @APIException bodyBS of+            Just e  -> throwM e+            Nothing -> throwM . flip JSONParseError bodyBS+                $ "getAccessToken: Failed to parse JSON - " <> T.pack err++-- | Generate the correct API 'APIAction' for an 'AppType'+mkAuthRoute :: Form -> APIAction a+mkAuthRoute form = defaultAPIAction+    { method       = POST+    , pathSegments = [ "api", "v1", "access_token" ]+    , requestData  = WithForm form+    }++-- | Convert an API 'APIAction' to a 'Request'+routeToRequest :: MonadThrow m => APIAction a -> m Request+routeToRequest APIAction { .. } = case requestData of+    WithForm fd -> case method of+        p+            | p `elem` [ POST, PUT ] -> pure+                $ mkRequest+                { H.requestBody = RequestBodyLBS $ urlEncodeAsFormStable fd }+        _ -> invalidRequest+    NoData      -> pure mkRequest+    _           -> invalidRequest+  where+    mkRequest      = H.defaultRequest+        { H.host   = "www.reddit.com"+        , H.secure = True+        , H.port   = 443+        , H.method = bshow method+        , H.path   = joinPathSegments pathSegments+        }++    invalidRequest = throwM $ InvalidRequest "Invalid request body"++setUAHeader :: AuthConfig -> Request -> Request+setUAHeader AuthConfig { .. } req =+    req { H.requestHeaders = newHeader : headers }+  where+    newHeader = (CI.mk "user-agent", ua)++    ua        = writeUA userAgent++    headers   = req & H.requestHeaders++-- | Refresh the access token+refreshAccessToken :: MonadReddit m => m AccessToken+refreshAccessToken = do+    ac@AuthConfig { .. } <- asks (^. field @"authConfig")+    case appType of+        ScriptApp {}       -> getAccessToken toForm ac+        ApplicationOnly {} -> getAccessToken toForm ac+        WebApp {}          -> tryRefresh ac+        InstalledApp {}    -> tryRefresh ac+  where+    tryRefresh ac = asks (^. field @"tokenManager") >>= \case+        Just TokenManager { .. } -> do+            token <- flip getAccessTokenWith ac =<< loadToken+            putToken $ token ^. field @"refreshToken"+            pure token+        Nothing                  -> lookupRefreshToken >>= \case+            Nothing ->+                cfgError "refreshAccessToken: No refresh token available"+            Just rt -> getAccessTokenWith rt ac++    lookupRefreshToken =+        readClientState $ field @"accessToken" . field @"refreshToken"++    cfgError           = throwM . ConfigurationError++-- | The endpoint for non-OAuth actions+redditURL :: ByteString+redditURL = "www.reddit.com"++-- | The endpoint for OAuth actions+oauthURL :: ByteString+oauthURL = "oauth.reddit.com"
+ src/Network/Reddit/Comment.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      : Network.Reddit.Comment+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Comment+    (  -- * Reading comments+      getComments+    , getComment+    , withReplies+    , loadMoreComments+    , loadMoreCommentsDef+    , unsaveComment+    , saveComment+      -- * Creating, editing, and deleting+    , deleteComment+    , editComment+    , replyToComment+    , getNewComments+    , setCommentReplies+      -- * Voting+      -- $vote+    , upvoteComment+    , downvoteComment+    , unvoteComment+    , reportComment+      -- * Types+    , module M+    ) where++import           Control.Monad.Catch             ( MonadThrow(throwM) )++import           Data.Generics.Wrapped           ( wrappedTo )+import           Data.Sequence                   ( Seq((:<|)) )+import qualified Data.Sequence                   as Seq++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Item+import           Network.Reddit.Types+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Comment    as M+                 ( ChildComment(..)+                 , Comment(Comment)+                 , CommentID(CommentID)+                 , MoreComments(MoreComments)+                 )+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Utils++import           Web.FormUrlEncoded              ( ToForm(toForm) )+import           Web.HttpApiData                 ( ToHttpApiData(toQueryParam)+                                                 )++-- | Get the 'Comment's corresponding to a container of 'CommentID's+getComments :: (MonadReddit m, Foldable t)+            => ItemOpts Comment+            -> t CommentID+            -> m (Seq Comment)+getComments = getMany++-- | Get information on a single 'CommentID'. Throws an exception if no such+-- 'Comment' exists+getComment :: MonadReddit m => CommentID -> m Comment+getComment cid = getComments defaultItemOpts [ cid ] >>= \case+    comment :<| _ -> pure comment+    _             -> throwM $ InvalidResponse "getComment: No results"++-- | Get new 'Comment's, either for the site as a whole or for a single subreddit,+-- given its 'SubredditName'+getNewComments :: MonadReddit m+               => Maybe SubredditName+               -> Paginator CommentID Comment+               -> m (Listing CommentID Comment)+getNewComments sname paginator =+    runAction defaultAPIAction+              { requestData  = paginatorToFormData paginator+              , pathSegments = [ "comments" ]+                    & maybe id (\s -> (<>) [ "r", toQueryParam s ]) sname+              }++-- | Update a 'Comment' to include its 'ChildComment's, returning the updated+-- 'Comment'. This will probably be necessary if the original 'Comment' was obtained+-- by getting a 'Username'\'s or 'Subreddit'\'s comments, etc...+withReplies :: MonadReddit m => ItemOpts a -> Comment -> m Comment+withReplies ItemOpts { .. } Comment { .. } =+    runAction @WithReplies r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments =+              [ "comments", toQueryParam linkID, "_", toQueryParam commentID ]+        , requestData  = mkTextFormData+              $ [ ("context", "100") ] -- asking for extra context+              <> foldMap pure (("sort", ) . toQueryParam <$> itemSort)+        }++-- | Save a comment+saveComment :: MonadReddit m => CommentID -> m ()+saveComment = save . CommentItemID++-- | Unsave a comment+unsaveComment :: MonadReddit m => CommentID -> m ()+unsaveComment = unsave . CommentItemID++-- | Delete a comment that the currently authenticated user has authored, given its+-- 'CommentID'+deleteComment :: MonadReddit m => CommentID -> m ()+deleteComment = delete . CommentItemID++-- | Edit a comment given its 'CommentID', receving an updated 'Comment' in response+editComment :: MonadReddit m => CommentID -> Body -> m Comment+editComment (CommentItemID -> cid) txt = edit cid txt >>= \case+    CommentItem c    -> pure c+    SubmissionItem _ -> throwM+        $ InvalidResponse "editComment: Expected a Comment, got a Submission"++-- | Reply to a comment given its 'CommentID', returning the newly created 'Comment'+replyToComment :: MonadReddit m => CommentID -> Body -> m Comment+replyToComment = reply . CommentItemID++-- | Enable/disable inbox replies for a comment+setCommentReplies :: MonadReddit m => Bool -> CommentID -> m ()+setCommentReplies p (CommentItemID -> cid) = setInboxReplies p cid++-- | Upvote a comment.+upvoteComment :: MonadReddit m => CommentID -> m ()+upvoteComment = vote Upvote . CommentItemID++-- | Downvote a comment.+downvoteComment :: MonadReddit m => CommentID -> m ()+downvoteComment = vote Downvote . CommentItemID++-- | Remove an existing vote on a comment.+unvoteComment :: MonadReddit m => CommentID -> m ()+unvoteComment = vote Unvote . CommentItemID++-- | Report a comment to the subreddit\'s mods+reportComment :: MonadReddit m => Report -> CommentID -> m ()+reportComment r = report r . CommentItemID++{- HLINT ignore "Use mconcat" -}+-- | Transform 'MoreComments', loading the actual comments they refer to, up to+-- the limit passed in (pass 'Nothing' for no limit). If 'CommentID's still remain+-- from the original 'MoreComments', they will be returned in a new 'MoreComments'+-- inserted into the resulting sequence of 'ChildComment's, along with an updated+-- count+loadMoreComments+    :: forall m.+    MonadReddit m+    => Maybe Word+    -> ItemOpts Comment+    -> SubmissionID+    -> MoreComments+    -> m (Seq ChildComment)+loadMoreComments limitM opts sid MoreComments { .. } = foldr (<>) mempty+    <$> traverse fetchMore (Seq.chunksOf 100 toFetch)+    <&> (<> more) -- appending this way, after the fold, will put @more@ at the end+  where+    fetchMore :: Seq CommentID -> m (Seq ChildComment)+    fetchMore cids = runAction @LoadedChildren r <&> wrappedTo+      where+        r = defaultAPIAction+            { pathSegments = [ "api", "morechildren" ]+            , method       = POST+            , requestData  = WithForm+                  $ toForm opts+                  <> mkTextForm [ ("link_id", fullname sid)+                                , ("api_type", "json")+                                , ("children", joinParams cids)+                                ]+            }++    more = case remaining of+        Seq.Empty -> mempty+        cids      -> Seq.singleton . More+            $ MoreComments cids (count - fromIntegral limit)++    (toFetch, remaining) = Seq.splitAt limit childIDs++    limit = maybe (length childIDs) fromIntegral limitM++-- | A version of 'loadMoreComments' with default parameters for the limit+-- (@Nothing@) and options ('defaultItemOpts')+loadMoreCommentsDef+    :: MonadReddit m => SubmissionID -> MoreComments -> m (Seq ChildComment)+loadMoreCommentsDef = loadMoreComments Nothing defaultItemOpts+--+-- $vote+-- __Note__: According to Reddit\'s API rules:+--+-- votes must be cast by humans. That is, API clients proxying a human's+-- action one-for-one are OK, but bots deciding how to vote on content or amplifying+-- a human's vote are not. See the reddit rules for more details on what constitutes+-- vote cheating.+--
+ src/Network/Reddit/Internal.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Internal+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Internal+    ( runAction+    , runAction_+    , runActionWith+    , runActionWith_+    , mkRequest+    , getMany+    , redditURL+    , oauthURL+    ) where++import           Conduit                               ( (.|), runConduit )++import           Control.Monad+import           Control.Monad.Catch                   ( MonadThrow(throwM) )+import           Control.Monad.IO.Class                ( MonadIO(liftIO) )+import           Control.Monad.Reader                  ( asks )++import           Data.Aeson+                 ( FromJSON+                 , decode+                 , eitherDecode+                 , encode+                 )+import           Data.Bool+import           Data.ByteString                       ( ByteString )+import qualified Data.ByteString.Lazy                  as LB+import qualified Data.CaseInsensitive                  as CI+import           Data.Conduit.Binary                   ( sinkLbs )+import qualified Data.Foldable                         as F+import           Data.Foldable                         ( for_ )+import           Data.Generics.Product                 ( HasField(field) )+import           Data.Ix+import           Data.List.Split                       ( chunksOf )+import           Data.Sequence                         ( Seq )+import qualified Data.Text                             as T+import           Data.Text                             ( Text )+import qualified Data.Text.Encoding                    as T+import           Data.Time.Clock.POSIX++import           Lens.Micro++import           Network.HTTP.Client.Conduit+                 ( Request+                 , RequestBody(RequestBodyLBS)+                 , Response+                 , withResponse+                 )+import qualified Network.HTTP.Client.Conduit           as H+import           Network.HTTP.Client.MultipartFormData ( formDataBody )+import qualified Network.HTTP.Conduit                  as H+import qualified Network.HTTP.Types                    as H+import           Network.Reddit.Auth+import           Network.Reddit.Types+import           Network.Reddit.Utils++import           UnliftIO.IORef++import           Web.FormUrlEncoded+                 ( ToForm(toForm)+                 , urlEncodeFormStable+                 )+import           Web.HttpApiData                       ( ToHttpApiData(..) )++-- | Run an 'APIAction' and decode the response JSON, governed by the type+-- parameterizing the action+runAction :: forall a m. (MonadReddit m, FromJSON a) => APIAction a -> m a+runAction action@APIAction { .. } = do+    ensureToken+    (resp, x) <- runActionWith followRedirects =<< prepareRequest action+    updateRateLimits resp+    pure x++-- | Run an action, discarding the response body+runAction_ :: forall m. MonadReddit m => APIAction () -> m ()+runAction_ action = do+    ensureToken+    updateRateLimits =<< runActionWith_ =<< prepareRequest action++ensureToken :: MonadReddit m => m ()+ensureToken = do+    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)+            , ()+            )++-- | Update the current rate limit info, reading it from Reddit\'s response+-- headers+updateRateLimits :: MonadReddit m => Response (RawBody m) -> m ()+updateRateLimits resp = do+    now <- liftIO getPOSIXTime+    for_ (resp & H.responseHeaders & readRateLimits now) $ \rls -> do+        state <- asks (^. field @"clientState")+        atomicModifyIORef' state $ \s -> (s & field @"limits" ?~ rls, ())++runActionWith :: forall a m.+              (MonadReddit m, FromJSON a)+              => Bool+              -> Request+              -> m (Response (RawBody m), a)+runActionWith followRedirects req = withResponse @_ @m req $ \resp -> do+    let body       = resp & H.responseBody+        status     = resp & H.responseStatus+        statusCode = status & H.statusCode+        headers    = resp & H.responseHeaders+        cookies    = resp & H.responseCookieJar+    bodyBS <- runConduit $ body .| sinkLbs+    if+        | inRange (300, 308) statusCode && not followRedirects -> throwM+            . Redirected+            $ H.getRedirectedRequest req headers cookies statusCode+        | otherwise -> case eitherDecode @a bodyBS of+            Right x  -> pure (resp, x)+            Left err -> case decode @APIException bodyBS of+                Just e  -> throwM e+                Nothing -> throwM . flip JSONParseError bodyBS+                    $ "runAction: Error parsing JSON - " <> T.pack err++runActionWith_+    :: forall m. MonadReddit m => Request -> m (Response (RawBody m))+runActionWith_ req = withResponse @_ @m req $ \resp -> do+    let body       = resp & H.responseBody+        status     = resp & H.responseStatus+        statusCode = status & H.statusCode+    bodyBS <- runConduit $ body .| sinkLbs+    if+        | (statusCode >= 300) -> case decode @APIException bodyBS of+            Just e  -> throwM e+            Nothing -> throwM+                $ JSONParseError "runAction_: Failed to parse error JSON"+                                 bodyBS+        | otherwise -> pure resp++prepareRequest :: MonadReddit m => APIAction a -> m Request+prepareRequest act@APIAction { .. } =+    bool (mkRequest redditURL act)+         (setHeaders =<< mkRequest oauthURL act)+         needsAuth++mkRequest :: MonadIO m => ByteString -> APIAction a -> m Request+mkRequest host APIAction { .. } = case requestData of+    WithJSON d       -> pure $ case method of+        p+            | p `elem` [ POST, PUT, PATCH ] -> request+                { H.requestBody    = RequestBodyLBS $ encode d+                , H.requestHeaders =+                      [ (CI.mk "content-type", "application/json") ]+                }+            | otherwise -> request+    WithForm fd      -> pure $ case method of+        GET -> request+            { H.queryString = (request & H.queryString)+                  <> "&"+                  <> LB.toStrict (urlEncodeFormStable fd)+            }++        p+            | p `elem` [ POST, PUT, PATCH ] -> request+                { H.requestBody    = RequestBodyLBS $ urlEncodeFormStable fd+                , H.requestHeaders = [ ( CI.mk "content-type"+                                       , "application/x-www-form-urlencoded"+                                       )+                                     ]+                }+        _   -> request+    WithMultipart ps -> case method of+        POST -> formDataBody ps request+        _    -> pure request+    NoData           -> pure request+  where+    request      = H.defaultRequest+        { H.host          = host+        , H.secure        = True+        , H.port          = 443+        , H.method        = bshow method+        , H.path          = joinPathSegments pathSegments+          -- add @raw_json@ param to get unescaped HTML in response bodies+        , H.queryString   = bool mempty rawJSONQuery rawJSON+        , H.redirectCount = bool 0 10 followRedirects+        , H.checkResponse = checkResponse+        }++    rawJSONQuery =+        H.renderQuery True $ H.toQuery @[(Text, Text)] [ ("raw_json", "1") ]++setHeaders :: MonadReddit m => Request -> m Request+setHeaders req = do+    userAgent <- asks (^. field @"authConfig" . field @"userAgent")+    token <- readClientState $ field @"accessToken" . field @"token"++    let newHeaders = [ (CI.mk "authorization", auth)+                     , (CI.mk "user-agent", writeUA userAgent)+                     ]+        auth       = "bearer " <> T.encodeUtf8 token+        headers    = req & H.requestHeaders+    pure req { H.requestHeaders = newHeaders <> headers }++-- | Get the items that correspond to a container of 'Thing' instances, for example+-- a sequence of 'Network.Reddit.Types.Comment.CommentID's, which will evaluate to a+-- 'Seq' of 'Network.Reddit.Types.Comment.Comment's+getMany :: forall a b t m.+        (MonadReddit m, Foldable t, Thing b, FromJSON a, FromJSON b)+        => ItemOpts a+        -> t b+        -> m (Seq a)+getMany opts ids = mconcat <$> traverse getChunk (chunked ids)+  where+    chunked = chunksOf apiRequestLimit . F.toList++    getChunk chunk = runAction (mkAction @(Listing b a) chunk)+        <&> (^. field @"children")++    mkAction :: forall c. [b] -> APIAction c+    mkAction cs = (defaultAPIAction @c)+        { pathSegments = [ "api", "info" ]+        , requestData  = WithForm+              $ toForm opts+              <> mkTextForm [ ("id", fullname cs)+                            , ("limit", toQueryParam @Int apiRequestLimit)+                            ]+        }
+ src/Network/Reddit/Item.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Item+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions with operate on 'Item's, which can be either 'Comment's or+-- 'Submission's+--+module Network.Reddit.Item+    (  -- * Actions+      delete+    , reply+    , edit+    , vote+    , report+    , save+    , unsave+    , setInboxReplies+    , getGildedItems+      -- * Types+    , module M+    ) where++import           Data.Generics.Wrapped          ( wrappedTo )++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Item      ( PostedItem )+import           Network.Reddit.Types.Item      as M+                 ( Item(..)+                 , ItemID(..)+                 , Report+                 , Vote(..)+                 , mkReport+                 )+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Utils++import           Web.HttpApiData+                 ( ToHttpApiData(toQueryParam, toUrlPiece)+                 )++-- | Delete an 'Item'+delete :: MonadReddit m => ItemID -> m ()+delete iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "del" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid) ]+               }++-- | Leave a comment in reply to an 'Item', which can be markdown-formatted. This+-- will return the newly created 'Comment' upon success+reply :: MonadReddit m => ItemID -> Body -> m Comment+reply iid txt = runAction @(PostedItem Comment) r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "comment" ]+        , method       = POST+        , requestData  = mkTextFormData [ ("thing_id", fullname iid)+                                        , ("text", txt)+                                        , ("api_type", "json")+                                        ]+        }++-- | Edit some item, given its 'ItemID'. The return value will be wrapped in an+-- 'Item' constructor, since it can be either a 'Comment' or 'Submission'+edit :: MonadReddit m => ItemID -> Body -> m Item+edit iid txt = runAction @(PostedItem Item) r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "editusertext" ]+        , method       = POST+        , requestData  = mkTextFormData [ ("thing_id", fullname iid)+                                        , ("text", txt)+                                        , ("api_type", "json")+                                        ]+        }++-- | Submit a vote. Be careful! Reddit views bot-based vote manipulation as a+-- serious violation+vote :: MonadReddit m => Vote -> ItemID -> m ()+vote v iid =+    runAction defaultAPIAction+              { pathSegments = [ "api", "vote" ]+              , method       = POST+              , requestData  =+                    mkTextFormData [ ("id", fullname iid), ("dir", voteDir) ]+              }+  where+    voteDir = case v of+        Downvote -> "-1"+        Unvote   -> "0"+        Upvote   -> "1"++-- | Report an item, which brings it to the attention of the subreddit moderators+report :: MonadReddit m => Report -> ItemID -> m ()+report r iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "report" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid)+                                               , ("reason", toQueryParam r)+                                               ]+               }++-- | Save an item+save :: MonadReddit m => ItemID -> m ()+save = saveOrUnsave "save"++-- | Unsave an item+unsave :: MonadReddit m => ItemID -> m ()+unsave = saveOrUnsave "unsave"++saveOrUnsave :: MonadReddit m => PathSegment -> ItemID -> m ()+saveOrUnsave path iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", path ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid) ]+               }++-- | Enable or disable inbox replies for an item given its 'ItemID'+setInboxReplies :: MonadReddit m => Bool -> ItemID -> m ()+setInboxReplies p iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "sendreplies" ]+               , requestData  = mkTextFormData [ ("id", fullname iid)+                                               , ("state", toQueryParam p)+                                               ]+               }++-- | Get a @Listing@ of 'Item's that have been gilded+getGildedItems :: MonadReddit m+               => SubredditName+               -> Paginator ItemID Item+               -> m (Listing ItemID Item)+getGildedItems sname paginator =+    runAction defaultAPIAction+              { pathSegments = [ "r", toUrlPiece sname, "gilded" ]+              , requestData  = paginatorToFormData paginator+              }
+ src/Network/Reddit/Live.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Live+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions for working with 'LiveThread's+--+module Network.Reddit.Live+    ( -- * Actions+      getLiveThread+    , getLiveInfo+    , getAllLiveInfo+    , getLiveUpdates+    , getLiveUpdate+    , getLiveDiscussions+    , getLiveContributors+    , reportLiveThread+    , createLiveThread+    , closeLiveThread+    , updateLiveThread+    , addLiveUpdate+    , strikeLiveUpdate+    , deleteLiveUpdate+      -- ** Live thread contribution+    , removeLiveContributor+    , removeLiveContributorByName+    , updateLiveContributor+    , abdicateLiveContributor+    , inviteLiveContributor+    , inviteLiveContributorWithPerms+    , revokeLiveInvitation+    , revokeLiveInvitationByName+      -- * Types+    , module M+    ) where++import           Control.Monad.Catch             ( MonadThrow(throwM) )++import qualified Data.Foldable                   as F+import           Data.Generics.Product           ( HasField(field) )+import           Data.Generics.Wrapped           ( wrappedTo )+import           Data.List.Split                 ( chunksOf )+import           Data.Sequence                   ( Seq((:<|)) )+import           Data.Traversable                ( for )++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Live+import           Network.Reddit.Types.Live       as M+                 ( LiveContributor(LiveContributor)+                 , LivePermission(..)+                 , LiveReportType(..)+                 , LiveState(..)+                 , LiveThread(LiveThread)+                 , LiveThreadID(LiveThreadID)+                 , LiveUpdate(LiveUpdate)+                 , LiveUpdateEmbed(LiveUpdateEmbed)+                 , LiveUpdateID(LiveUpdateID)+                 , NewLiveThread+                 , PostableLiveThread(PostableLiveThread)+                 , UpdatedLiveThread+                 , liveThreadToPostable+                 , mkNewLiveThread+                 )+import           Network.Reddit.Types.Submission+import           Network.Reddit.User+import           Network.Reddit.Utils++import           Web.FormUrlEncoded              ( ToForm(toForm) )+import           Web.HttpApiData                 ( ToHttpApiData(..) )+import           Web.Internal.FormUrlEncoded     ( Form )++-- | Get the details on a single 'LiveThread' given its ID+getLiveThread :: MonadReddit m => LiveThreadID -> m LiveThread+getLiveThread ltid =+    runAction defaultAPIAction+              { pathSegments = liveThreadPath [ toQueryParam ltid, "about" ] }++-- | Get information about live threads corresponding to each of the+-- 'LiveThreadID's in the given container. Invalid IDs are silently discarded+-- by this endpoint+--+-- __Note__: This endpoint will only accept a maximum of 100 'LiveThreadID's. If+-- you would like to get all of the information for a larger number of 'LiveThread's+-- at once, see 'getAllLiveInfo'+getLiveInfo :: (MonadReddit m, Foldable t)+            => t LiveThreadID+            -> Paginator LiveThreadID LiveThread+            -> m (Listing LiveThreadID LiveThread)+getLiveInfo ltids paginator =+    runAction defaultAPIAction+              { pathSegments = liveThreadPath [ "by_id", joinParams ltids ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get all of the 'LiveThread's corresponding to a container of 'LiveThreadID's,+-- without a limit+getAllLiveInfo+    :: (MonadReddit m, Traversable t) => t LiveThreadID -> m (Seq LiveThread)+getAllLiveInfo ltids = fmap mconcat . for (chunked ltids) $ \ls ->+    getLiveInfo ls emptyPaginator { limit = apiRequestLimit }+    <&> (^. field @"children")+  where+    chunked = chunksOf apiRequestLimit . F.toList++-- | Get a @Listing@ of 'LiveUpdate's for the given live thread+getLiveUpdates :: MonadReddit m+               => LiveThreadID+               -> Paginator LiveUpdateID LiveUpdate+               -> m (Listing LiveUpdateID LiveUpdate)+getLiveUpdates ltid paginator =+    runAction defaultAPIAction+              { pathSegments = [ "live", toQueryParam ltid ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get a single 'LiveUpdate' for the given live thread+getLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m LiveUpdate+getLiveUpdate ltid luid = do+    Listing { children } <- runAction @(Listing LiveUpdateID LiveUpdate) r+    case children of+        liveUpdate :<| _ -> pure liveUpdate+        _                -> throwM+            $ InvalidResponse "getLiveUpdate: No matching live update found"+  where+    r = defaultAPIAction+        { pathSegments =+              [ "live", toQueryParam ltid, "updates", toUrlPiece luid ]+        }++-- | Get a @Listing@ of 'Submission's representing the discussions on the given+-- live thread+getLiveDiscussions :: MonadReddit m+                   => LiveThreadID+                   -> Paginator SubmissionID Submission+                   -> m (Listing SubmissionID Submission)+getLiveDiscussions ltid paginator =+    runAction defaultAPIAction+              { pathSegments =+                    liveThreadPath [ toQueryParam ltid, "discussions" ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get a list of contributors to the live thread+getLiveContributors+    :: MonadReddit m => LiveThreadID -> m (Seq LiveContributor)+getLiveContributors ltid = runAction @LiveContributorList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = liveThreadPath [ toQueryParam ltid, "contributors" ]+        }++-- | Report the given live thread to Reddit admins with the provided reason+reportLiveThread :: MonadReddit m => LiveReportType -> LiveThreadID -> m ()+reportLiveThread lrt ltid =+    runAction_ defaultAPIAction+               { pathSegments = liveThreadPath [ toQueryParam ltid, "report" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("type", toQueryParam lrt)+                                               , ("api_type", "json")+                                               ]+               }++-- | Create a 'NewLiveThread', returning the 'LiveThread' upon success. Also see+-- 'mkNewLiveThread'+createLiveThread :: MonadReddit m => NewLiveThread -> m LiveThread+createLiveThread nlt = getLiveThread+    =<< (runAction @PostedLiveThread r <&> wrappedTo)+  where+    r = defaultAPIAction+        { pathSegments = liveThreadPath [ "create" ]+        , method       = POST+        , requestData  = WithForm $ toForm nlt+        }++-- | Close an existing live thread. After closing, it is no longer possible to+-- update or modify the live thread+--+-- __Warning__: This action is irreversible+closeLiveThread :: MonadReddit m => LiveThreadID -> m ()+closeLiveThread ltid =+    runAction_ defaultAPIAction+               { pathSegments =+                     liveThreadPath [ toQueryParam ltid, "close_thread" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("api_type", "json") ]+               }++-- | Update the existing live thread with new settings+updateLiveThread :: MonadReddit m => LiveThreadID -> UpdatedLiveThread -> m ()+updateLiveThread ltid ult =+    runAction defaultAPIAction+              { pathSegments = liveThreadPath [ toQueryParam ltid, "edit" ]+              , method       = POST+              , requestData  = WithForm $ toForm ult+              }++-- | Add an update to the live thread+addLiveUpdate :: MonadReddit m => LiveThreadID -> Body -> m ()+addLiveUpdate ltid b =+    runAction_ defaultAPIAction+               { pathSegments = liveThreadPath [ toQueryParam ltid, "update" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("body", b), ("api_type", "json") ]+               }++-- | Strike the existing 'LiveUpdate', causing its @stricken@ field to be @True@+-- and the content to be crossed-out and marked incorrect on the web UI+strikeLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m ()+strikeLiveUpdate = strikeDeleteUpdate "strike_update"++-- | Strike the existing 'LiveUpdate', causing its @stricken@ field to be @True@+-- and the content to be crossed-out and marked incorrect on the web UI+deleteLiveUpdate :: MonadReddit m => LiveThreadID -> LiveUpdateID -> m ()+deleteLiveUpdate = strikeDeleteUpdate "delete_update"++strikeDeleteUpdate+    :: MonadReddit m => PathSegment -> LiveThreadID -> LiveUpdateID -> m ()+strikeDeleteUpdate path ltid luid =+    runAction_ defaultAPIAction+               { pathSegments = liveThreadPath [ toQueryParam ltid, path ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname luid)+                                               , ("api_type", "json")+                                               ]+               }++-- | Remove the user as a contributor to the live thread. If you don\'t know the+-- contributor\'s user ID, you can use 'removeLiveContributorByName'+removeLiveContributor :: MonadReddit m => LiveThreadID -> UserID -> m ()+removeLiveContributor ltid uid =+    runAction defaultAPIAction+              { pathSegments = liveThreadPath [ toQueryParam ltid+                                              , "remove_live_contributor"+                                              ]+              , requestData  = mkTextFormData [ ("id", fullname uid) ]+              }++-- | Remove the live contributor by username. Note that this action must perform+-- an additional network request to fetch the user ID from the given username+removeLiveContributorByName+    :: MonadReddit m => LiveThreadID -> Username -> m ()+removeLiveContributorByName ltid uname = do+    Account { userID } <- getUser uname+    removeLiveContributor ltid userID++-- | Update the permissions for the live contributor+updateLiveContributor+    :: (MonadReddit m, Foldable t)+    => Maybe (t LivePermission)+    -- ^ If @Nothing@, grants all contributor permissions. If @Just@ but empty,+    -- removes all permissions+    -> LiveThreadID+    -> Username+    -> m ()+updateLiveContributor perms ltid uname =+    runAction_ defaultAPIAction+               { pathSegments =+                     [ toQueryParam ltid, "set_contributor_permissions" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("name", toQueryParam uname)+                                    , ("type", "liveupdate_contributor")+                                    , ( "permissions"+                                      , maybe "+all" joinPerms perms+                                      )+                                    , ("api_type", "json")+                                    ]+               }++-- | Abdicate your role as a live contributor, removing all access and permissions+--+-- __Warning__: This cannot be undone, even if you are the creator of the live+-- thread+abdicateLiveContributor :: MonadReddit m => LiveThreadID -> m ()+abdicateLiveContributor ltid =+    runAction_ defaultAPIAction+               { pathSegments =+                     liveThreadPath [ toQueryParam ltid, "leave_contributor" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("api_type", "json") ]+               }++-- | Invite a user to contribute to the live thread. Note that this implicitly+-- grants all permissions to the invitee. If you would like more fine-grained+-- control over permissions, see 'inviteLiveContributorWithPerms'+inviteLiveContributor :: MonadReddit m => LiveThreadID -> Username -> m ()+inviteLiveContributor =+    inviteContributors $ mkTextForm [ ("permissions", "+all") ]++-- | As 'inviteLiveContributor', but allows customization of the permissions+-- granted to the invitee+inviteLiveContributorWithPerms+    :: (MonadReddit m, Foldable t)+    => t LivePermission -- ^ If empty, grants no permissions+    -> LiveThreadID+    -> Username+    -> m ()+inviteLiveContributorWithPerms perms =+    inviteContributors $ mkTextForm [ ("permissions", joinPerms perms) ]++-- | Revoke the invitation to contribute to the live thread. If you don\'t know+-- the contributor\'s user ID, you can use 'revokeLiveInvitationByName'+revokeLiveInvitation :: MonadReddit m => LiveThreadID -> UserID -> m ()+revokeLiveInvitation ltid uid =+    runAction_ defaultAPIAction+               { pathSegments = liveThreadPath [ toQueryParam ltid+                                               , "rm_contributor_invite"+                                               ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname uid)+                                               , ("api_type", "json")+                                               ]+               }++-- | Revoke the live invitation by username. Note that this action must perform+-- an additional network request to fetch the user ID from the given username+revokeLiveInvitationByName+    :: MonadReddit m => LiveThreadID -> Username -> m ()+revokeLiveInvitationByName ltid uname = do+    Account { userID } <- getUser uname+    revokeLiveInvitation ltid userID++inviteContributors+    :: MonadReddit m => Form -> LiveThreadID -> Username -> m ()+inviteContributors form ltid uname =+    runAction_ defaultAPIAction+               { pathSegments = liveThreadPath [ toQueryParam ltid+                                               , "invite_contributor"+                                               ]+               , method       = POST+               , requestData  = WithForm+                     $ mkTextForm [ ("name", toQueryParam uname)+                                  , ("type", "liveupdate_contributor_invite")+                                  , ("api_type", "json")+                                  ]+                     <> form+               }++liveThreadPath :: [PathSegment] -> [PathSegment]+liveThreadPath ps = [ "api", "live" ] <> ps
+ src/Network/Reddit/Me.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Me+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions related to the currently logged-in user, such as accounts, friends,+-- etc... For actions related to other users, see "Network.Reddit.User"+--+module Network.Reddit.Me+    (  -- * Actions+      getMe+    , getPreferences+    , updatePreferences+    , getMyOverview+    , getMySaved+    , getMyComments+    , getMySubmissions+    , getMyHidden+    , getMyFriends+    , getMyBlocked+    , getMyKarma+    , makeFriend+    , unFriend+    , blockUser+    , needsCaptcha+    , getMyFlair+    , setMyFlair+    , getMySubscribed+    , getMyModerated+    , getMyContributing+    , getMyMultireddits+    ) where++import           Control.Monad.Catch+                 ( MonadCatch(catch)+                 , MonadThrow(throwM)+                 )++import           Data.Aeson                       ( KeyValue((.=)), object )+import           Data.Bool                        ( bool )+import           Data.Generics.Wrapped            ( wrappedTo )+import           Data.Sequence                    ( Seq )+import           Data.Text                        ( Text )++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Item+import           Network.Reddit.Types.Multireddit+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.User+import           Network.Reddit.Utils++import           Web.FormUrlEncoded               ( ToForm(toForm) )+import           Web.HttpApiData                  ( ToHttpApiData(..) )++-- | Get account information for the currently logged-in user+getMe :: MonadReddit m => m Account+getMe = runAction defaultAPIAction { pathSegments = mePath mempty }++-- | Get the user 'Preferences' for the currently authenticated user+getPreferences :: MonadReddit m => m Preferences+getPreferences =+    runAction defaultAPIAction { pathSegments = mePath [ "prefs" ] }++-- | Update the authenticated users 'Preferences'. Returns the new preferences+-- upon success+--+-- __Warning__: Invalid fields or values are silently discarded by this+-- endpoint. If you wish to check that an update has succeeded, consider+-- an equality test between the existing preferences and the value returned+-- by this action+updatePreferences :: MonadReddit m => Preferences -> m Preferences+updatePreferences prefs =+    runAction defaultAPIAction+              { pathSegments = mePath [ "prefs" ]+              , method       = PATCH+              , requestData  = mkTextFormData [ ("json", textEncode prefs) ]+              }++-- | Get an overview of the authenticated user\'s 'Comment's and 'Submission's+getMyOverview+    :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item)+getMyOverview paginator = do+    Account { username } <- getMe+    getUserOverview username paginator++-- | Get items that the authenticated user has saved+getMySaved+    :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item)+getMySaved paginator = do+    Account { username } <- getMe+    getUserSaved username paginator++-- | Get an overview of the authenticated user\'s 'Comment's+getMyComments :: MonadReddit m+              => Paginator CommentID Comment+              -> m (Listing CommentID Comment)+getMyComments paginator = do+    Account { username } <- getMe+    getUserComments username paginator++-- | Get an overview of the authenticated user\'s 'Submission's+getMySubmissions :: MonadReddit m+                 => Paginator SubmissionID Submission+                 -> m (Listing SubmissionID Submission)+getMySubmissions paginator = do+    Account { username } <- getMe+    getUserSubmissions username paginator++-- | Get items that the authenticated user has hidden+getMyHidden+    :: MonadReddit m => Paginator ItemID Item -> m (Listing ItemID Item)+getMyHidden paginator = do+    Account { username } <- getMe+    getUserHidden username paginator++-- | Get the 'Friend's of the currently logged-in user+getMyFriends :: MonadReddit m => m (Seq Friend)+getMyFriends = runAction @FriendList r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = mePath [ "friends" ] }++-- | Get blocked users (as 'Friend's) of the currently logged-in user+getMyBlocked :: MonadReddit m => m (Seq Friend)+getMyBlocked = runAction @FriendList r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = [ "prefs", "blocked" ] }++-- | Get a breakdown of the current user\'s karma+getMyKarma :: MonadReddit m => m (Seq Karma)+getMyKarma = runAction @KarmaList r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = mePath [ "karma" ] }++-- | Make friends with another user+makeFriend :: MonadReddit m => Maybe Text -> Username -> m Friend+makeFriend note uname =+    runAction defaultAPIAction+              { method       = PUT+              , pathSegments = mePath [ "friends", toUrlPiece uname ]+              , requestData  = WithJSON . object+                    $ [ "name" .= toQueryParam uname ]+                    <> foldMap (pure . ("note" .=)) note+              }++-- | Remove an existing friend+unFriend :: MonadReddit m => Username -> m ()+unFriend uname =+    runAction_ defaultAPIAction+               { pathSegments = mePath [ "friends", toUrlPiece uname ]+               , method       = DELETE+               }++-- | Block another user. Note that this cannot be reversed through the API; the+-- logged-in user would need to manually revoke the block by visiting Reddit's+-- website+blockUser :: MonadReddit m => UserID -> m ()+blockUser uid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "block_user" ]+               , method       = POST+               , requestData  = WithForm+                     $ toForm @[(Text, Text)] [ ("account_id", fullname uid) ]+               }++-- | Get the authenticated user\'s current flair for the given subreddit, if such+-- flair exists+getMyFlair :: MonadReddit m => SubredditName -> m (Maybe UserFlair)+getMyFlair sname = catch @_ @APIException action $ \case+    JSONParseError _ _ -> pure Nothing+    e                  -> throwM e+  where+    action = runAction @CurrentUserFlair r <&> Just . wrappedTo++    r      = defaultAPIAction+        { pathSegments = subAPIPath sname "flairselector"  --+        , method       = POST+        }++-- | Set the flair for the authenticated user, provided that the given subreddit+-- allows users to perform this action. The @text@ field is ignored unless it is+-- @Just@ /and/ the @textEditable@ field of the contained 'FlairChoice' is @True@+setMyFlair :: MonadReddit m => FlairSelection -> m ()+setMyFlair (FlairSelection FlairChoice { .. } txt sname) = do+    Account { username } <- getMe+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "selectflair"+               , method       = POST+               , requestData  = WithForm+                     $ mkTextForm [ ( "flair_template_id"+                                    , toQueryParam templateID+                                    )+                                  , ("name", toQueryParam username)+                                  ]+                     <> maybe mempty sendText txt+               }+  where+    sendText t =+        mkTextForm $ bool mempty [ ("text", toQueryParam t) ] textEditable++-- | Find out if the authenticated user needs to complete a captcha when performing+-- certain transactions, such as submitting a link or sending a private message+needsCaptcha :: MonadReddit m => m Bool+needsCaptcha = runAction defaultAPIAction+                         { pathSegments = [ "api", "needs_captcha.json" ]+                         , needsAuth    = False+                         }++getMySubscribed, getMyModerated, getMyContributing+    :: MonadReddit m+    => Paginator SubredditID Subreddit+    -> m (Listing SubredditID Subreddit)++-- | Get a listing of subreddits the currently authenticated user is subscribed to+getMySubscribed = mySubreddits "subscriber"++-- | Get a listing of subreddits the currently authenticated user is a mod in+getMyModerated = mySubreddits "moderator"++-- | Get a listing of subreddits the currently authenticated user is an approved+-- user in+getMyContributing = mySubreddits "contributor"++mySubreddits :: MonadReddit m+             => PathSegment+             -> Paginator SubredditID Subreddit+             -> m (Listing SubredditID Subreddit)+mySubreddits path paginator =+    runAction defaultAPIAction+              { pathSegments = [ "subreddits", "mine", path ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get all of the multireddits of the authenticated user+getMyMultireddits :: MonadReddit m => m (Seq Multireddit)+getMyMultireddits =+    runAction defaultAPIAction { pathSegments = [ "api", "multi", "mine" ] }++mePath :: [PathSegment] -> [PathSegment]+mePath ps = [ "api", "v1", "me" ] <> ps
+ src/Network/Reddit/Message.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Message+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions for messaging. These can be both comment replies as well as private+-- messages+--+module Network.Reddit.Message+    (  -- * Actions+      getInbox+    , getUnread+    , getSent+    , markRead+    , sendMessage+    , replyToMessage+    , reportMessage+      -- * Types+    , module M+    ) where++import           Data.Generics.Wrapped        ( wrappedTo )+import           Data.Text                    ( Text )++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Item+import           Network.Reddit.Types.Message+import           Network.Reddit.Types.Message as M+                 ( Message(Message)+                 , MessageID+                 , MessageOpts(MessageOpts)+                 , NewMessage(NewMessage)+                 , PrivateMessageID(PrivateMessageID)+                 )+import           Network.Reddit.Utils++import           Web.FormUrlEncoded           ( ToForm(toForm) )+import           Web.HttpApiData              ( ToHttpApiData(toQueryParam) )++-- | Get the 'Message' inbox for the currently authenticated user+getInbox :: MonadReddit m+         => Paginator MessageID Message+         -> m (Listing MessageID Message)+getInbox = msgs "inbox"++-- | Get the unread 'Message's of the currently authenticated user+getUnread :: MonadReddit m+          => Paginator MessageID Message+          -> m (Listing MessageID Message)+getUnread = msgs "unread"++-- | Get the 'Message's sent by the currently authenticated user+getSent :: MonadReddit m+        => Paginator MessageID Message+        -> m (Listing MessageID Message)+getSent = msgs "sent"++-- | Mark a 'Message' as read+markRead :: MonadReddit m => MessageID -> m ()+markRead mid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "read_message" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname mid) ]+               }++-- | Send a 'NewMessage'  to another user+sendMessage :: MonadReddit m => NewMessage -> m ()+sendMessage newMsg =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "compose" ]+               , method       = POST+               , requestData  = WithForm $ toForm newMsg+               }++-- | Reply to a 'Message', returning the newly created 'Message'+replyToMessage :: MonadReddit m => MessageID -> Body -> m Message+replyToMessage mid txt = runAction @PostedMessage r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "comment" ]+        , method       = POST+        , requestData  = WithForm+              $ toForm @[(Text, Text)]+                       [ ("thing_id", fullname mid)+                       , ("text", txt)+                       , ("api_type", "json")+                       ]+        }++msgs :: MonadReddit m+     => Text+     -> Paginator MessageID Message+     -> m (Listing MessageID Message)+msgs path paginator = runAction defaultAPIAction+                                { pathSegments = [ "message", path ]+                                , requestData  = paginatorToFormData paginator+                                }++-- | Report a message, bringing it to the attention of the Reddit admins+reportMessage :: MonadReddit m => Report -> MessageID -> m ()+reportMessage r mid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "report" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", toQueryParam mid)+                                               , ("reason", toQueryParam r)+                                               ]+               }
+ src/Network/Reddit/Moderation.hs view
@@ -0,0 +1,1973 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      : Network.Reddit.Moderation+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions related to moderation. Assume that each action in this module requires+-- moderator privileges, unless stated otherwise+--+module Network.Reddit.Moderation+    (  -- * Item moderation+        -- | These actions work on 'Item's, i.e either 'Comment's or 'Submission's.+        -- This module also exports variants that take unwrapped 'SubmissionID's+        -- and 'CommentID's to work with just one type of item (see below)+      distinguishItem+    , undistinguishItem+    , removeItem+    , sendRemovalMessage+    , approveItem+    , lockItem+    , unlockItem+    , ignoreItemReports+    , unignoreItemReports+      -- ** Removal reasons+    , getRemovalReasons+    , createRemovalReason+    , updateRemovalReason+    , deleteRemovalReason+      -- ** Moderation listings+      -- | Each of these retrieves a @Listing ItemID ModItem@. You can constrain+      -- the type of reports by passing the appropriate 'ItemType' to the+      -- paginator options+    , getReports+    , getModqueue+    , getSpam+    , getEdited+    , getUnmoderated+    , getModlog+      -- ** Submission moderation+      -- | Includes re-exports from "Network.Reddit.Submission"+    , distinguishSubmission+    , undistinguishSubmission+    , approveSubmission+    , lockSubmission+    , unlockSubmission+    , ignoreSubmissionReports+    , unignoreSubmissionReports+    , unmarkNSFW+    , markNSFW+    , setOC+    , unsetOC+    , setSpoiler+    , unsetSpoiler+    , stickySubmission+    , unstickySubmission+    , setSuggestedSort+      -- ** Comment moderation+    , showComment+    , distinguishComment+    , undistinguishComment+    , approveComment+    , lockComment+    , unlockComment+    , ignoreCommentReports+    , unignoreCommentReports+      -- ** Collections moderation+    , createCollection+    , deleteCollection+    , addSubmissionToCollection+    , removeSubmissionFromCollection+    , reorderCollection+    , updateCollectionDescription+    , updateCollectionTitle+      -- * Subreddit relationships+      -- ** Moderators+    , getModerators+    , getModerator+    , updateModerator+    , removeModerator+    , abdicateModerator+      -- ** Mod invitations+    , inviteModerator+    , inviteModeratorWithPerms+    , getInvitees+    , getInvitee+    , updateInvitation+    , revokeInvitation+    , acceptInvitation+      -- ** Contributors+    , getContributors+    , getContributor+    , addContributor+    , removeContributor+    , abdicateContributor+    , getWikiContributors+    , getWikiContributor+    , addWikiContributor+    , removeWikiContributor+      -- ** Bans+    , getBans+    , getBan+    , banUser+    , unbanUser+    , getWikibans+    , getWikiban+    , wikibanUser+    , wikiUnbanUser+    , getMuted+    , getMutedUser+    , unmuteUser+    , muteUser+      -- * Subreddit settings+    , getSubredditSettings+    , setSubredditSettings+      -- * Subreddit rules+      -- | To get a list of the current rules for a Subreddit,+      -- an action which does not require moderator privileges,+      -- see 'Network.Reddit.Actions.Subreddit.getSubredditRules'.+      -- Also note that a subreddit may only configure up to 15+      -- individual rules at a time, and that trying to add more may+      -- raise an exception+    , addSubredditRule+    , deleteSubredditRule+    , updateSubredditRule+    , reorderSubredditRules+      -- * Flair+    , getFlairList+    , getUserFlair+    , setUserFlair+    , setUserFlairs+    , deleteUserFlair+    , createFlairTemplate+    , updateFlairTemplate+    , createUserFlairTemplate+    , createSubmissionFlairTemplate+    , updateSubmissionFlairTemplate+    , updateUserFlairTemplate+    , deleteFlairTemplate+    , clearUserFlairTemplates+    , clearSubmissionFlairTemplates+    , clearFlairTemplates+      -- * Stylesheets, images and widgets+    , getStylesheet+    , updateStylesheet+      -- ** Images+      -- | Reddit only allows JPEG or PNG images in stylsheets, and further requires+      -- that all -- uploaded images be less than 500Kb in size. Each action that+      -- uploads an image file to stylesheets validates both of these constraints,+      -- throwing a 'ClientException' in the event that they are not satisfied.+      --+      -- Note that most of the actions that delete images will appear to succeed+      -- even if the named image does not exists+    , uploadImage+    , uploadHeader+    , uploadMobileIcon+    , uploadMobileHeader+    , deleteImage+    , deleteHeader+    , deleteMobileIcon+    , uploadBanner+    , deleteBanner+    , uploadBannerAdditional+    , deleteBannerAdditional+    , uploadBannerHover+    , deleteBannerHover+      -- * Wiki+    , addWikiEditor+    , removeWikiEditor+    , getWikiPageSettings+    , revertWikiPage+      -- * Modmail+    , getModmail+    , getModmailWithOpts+    , getModmailConversation+    , getUnreadModmailCount+    , replyToConversation+    , archiveConversation+    , unarchiveConversation+    , highlightConversation+    , unhighlightConversation+    , markConversationsRead+    , markConversationRead+    , markConversationsUnread+    , markConversationUnread+    , bulkReadConversations+    , muteModmailUser+    , unmuteModmailUser+    , createConversation+      -- * Widgets+    , deleteWidget+    , updateWidget+    , reorderWidgets+    , addButtonWidget+    , addCalendarWidget+    , addCommunityListWidget+    , addCustomWidget+    , addImageWidget+    , addMenuWidget+    , addPostFlairWidget+    , addTextAreaWidget+    , uploadWidgetImage+      -- * Emoji+    , addEmoji+    , deleteEmoji+    , updateEmoji+    , setCustomEmojiSize+      -- * Misc+    , getTraffic+      -- * Types+    , module M+    ) where++import           Conduit+                 ( (.|)+                 , runConduit+                 , withSourceFile+                 )++import           Control.Monad                         ( void, when )+import           Control.Monad.Catch+                 ( MonadCatch(catch)+                 , MonadThrow(throwM)+                 )++import           Data.Aeson+                 ( FromJSON+                 , KeyValue((.=))+                 , ToJSON(toJSON)+                 , Value(..)+                 )+import           Data.Bifunctor                        ( Bifunctor(bimap) )+import           Data.Bool                             ( bool )+import           Data.ByteString                       ( ByteString )+import qualified Data.ByteString.Lazy                  as LB+import           Data.Conduit.Binary                   ( sinkLbs )+import qualified Data.Foldable                         as F+import           Data.Foldable                         ( for_ )+import           Data.Generics.Wrapped+import           Data.HashMap.Strict                   ( HashMap )+import qualified Data.HashMap.Strict                   as HM+import           Data.Ix                               ( Ix(inRange) )+import           Data.List.Split                       ( chunksOf )+import           Data.Maybe                            ( fromMaybe )+import           Data.Sequence                         ( Seq((:<|)) )+import qualified Data.Text                             as T+import           Data.Text                             ( Text )+import qualified Data.Text.Encoding                    as T++import           Lens.Micro++import           Network.HTTP.Client.MultipartFormData ( partBS, partFile )+import           Network.Reddit.Internal+import           Network.Reddit.Me+import           Network.Reddit.Submission+import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Emoji+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Item+import           Network.Reddit.Types.Moderation+import           Network.Reddit.Types.Moderation       as M+                 ( Ban(Ban)+                 , BanNotes(BanNotes)+                 , ContentOptions(..)+                 , CrowdControlLevel(..)+                 , LanguageCode(..)+                 , ModAccount(ModAccount)+                 , ModAction(ModAction)+                 , ModActionID+                 , ModActionOpts(ModActionOpts)+                 , ModActionType(..)+                 , ModInvitee(ModInvitee)+                 , ModInviteeList(ModInviteeList)+                 , ModItem(..)+                 , ModItemOpts(ModItemOpts)+                 , ModPermission(..)+                 , Modmail(Modmail)+                 , ModmailAuthor(ModmailAuthor)+                 , ModmailConversation(ModmailConversation)+                 , ModmailID+                 , ModmailMessage(ModmailMessage)+                 , ModmailObjID(ModmailObjID)+                 , ModmailOpts(ModmailOpts)+                 , ModmailReply(ModmailReply)+                 , ModmailSort(..)+                 , ModmailState(..)+                 , MuteID(MuteID)+                 , MuteInfo(MuteInfo)+                 , NewConversation(NewConversation)+                 , NewRemovalReasonID+                 , RelID(RelID)+                 , RelInfo(RelInfo)+                 , RelInfoOpts(RelInfoOpts)+                 , RemovalMessage(RemovalMessage)+                 , RemovalReason(RemovalReason)+                 , RemovalReasonID+                 , RemovalType(..)+                 , S3ModerationLease(S3ModerationLease)+                 , SpamFilter(..)+                 , StructuredStyleImage(..)+                 , StyleImageAlignment(..)+                 , Stylesheet(Stylesheet)+                 , SubredditImage(SubredditImage)+                 , SubredditRelationship(..)+                 , SubredditSettings(SubredditSettings)+                 , SubredditType(..)+                 , Traffic(Traffic)+                 , TrafficStat(TrafficStat)+                 , Wikimode(..)+                 , defaultModmailOpts+                 , mkModmailReply+                 )+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Types.Widget+import           Network.Reddit.Types.Wiki+import           Network.Reddit.Utils++import qualified System.FilePath                       as FP++import           Web.FormUrlEncoded+                 ( Form+                 , ToForm(toForm)+                 )+import           Web.HttpApiData                       ( ToHttpApiData(..) )++--Item moderation--------------------------------------------------------------+-- | Distinguish an item. See 'distinguishComment' for further comment-specific+-- options+distinguishItem :: MonadReddit m => Distinction -> ItemID -> m ()+distinguishItem how iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "distinguish" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid)+                                               , ("how", toQueryParam how)+                                               ]+               }++-- | Remove the distinction from an item, also removing the sticky flag+-- for top-level comments+undistinguishItem :: MonadReddit m => ItemID -> m ()+undistinguishItem = distinguishItem Undistinguished++-- | Remove an item from the subreddit with an optional note to other mods.+-- Setting the @isSpam@ parameter to @True@ will entirely remove the item+-- from subreddit listings+removeItem+    :: MonadReddit m+    => Maybe Body -- ^ A note for other mods. This is sent in second request+                  -- if @Just@+    -> Bool  -- ^ Spam flag. Will remove the item from all listings if @True@+    -> ItemID+    -> m ()+removeItem note isSpam iid = do+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "remove" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid)+                                               , ("spam", toQueryParam isSpam)+                                               ]+               }+    for_ note $ \n ->+        runAction_ defaultAPIAction+                   { pathSegments =+                         [ "api", "v1", "modactions", "removal_reasons" ]+                   , method       = POST+                   , requestData  =+                         mkTextFormData [ ( "json"+                                          , textObject [ "item_ids"+                                                         .= [ fullname iid ]+                                                       , "mod_note" .= n+                                                       ]+                                          )+                                        ]+                   }++-- | Send a removal message for an item. The precise action depends on the form+-- of 'RemovalType'+sendRemovalMessage :: MonadReddit m => RemovalMessage -> m ()+sendRemovalMessage rm@RemovalMessage { .. } =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "v1", "modactions" ] <> [ getPath ]+               , method       = POST+               , requestData  = WithForm $ toForm rm+               }+  where+    getPath = case itemID of+        CommentItemID _    -> "removal_comment_message"+        SubmissionItemID _ -> "removal_link_message"++approveItem, lockItem, unlockItem :: MonadReddit m => ItemID -> m ()++-- | Approve an item, reverting a removal and resetting its report counter+approveItem = withID "approve"++-- | Lock an item. See also 'unlockItem'+lockItem = withID "lock"++-- | Unlock an item+unlockItem = withID "unlock"++ignoreItemReports, unignoreItemReports :: MonadReddit m => ItemID -> m ()++-- | Prevent all future reports on this item from sending notifications or appearing+-- in moderation listings. See also 'unignoreItemReports', which reverses this action+ignoreItemReports = withID "ignore_reports"++-- | Re-allow the item to trigger notifications and appear in moderation listings+unignoreItemReports = withID "unignore_reports"++withID :: MonadReddit m => Text -> ItemID -> m ()+withID path iid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", path ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname iid) ]+               }++-- | Get a list of 'RemovalReason's for the given subreddit+getRemovalReasons :: MonadReddit m => SubredditName -> m (Seq RemovalReason)+getRemovalReasons sname = runAction @RemovalReasonList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "v1", toUrlPiece sname, "removal_reasons" ]+        }++-- | Create a new 'RemovalReason', returning the 'RemovalReasonID' of the newly+-- created reason+createRemovalReason+    :: MonadReddit m => SubredditName -> Title -> Body -> m RemovalReasonID+createRemovalReason sname t m = runAction @NewRemovalReasonID r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "v1", toUrlPiece sname, "removal_reasons" ]+        , method       = POST+        , requestData  = mkTextFormData [ ("title", t), ("message", m) ]+        }++-- | Update a single 'RemovalReason'+updateRemovalReason :: MonadReddit m => SubredditName -> RemovalReason -> m ()+updateRemovalReason sname rr@RemovalReason { .. } =+    runAction_ defaultAPIAction+               { pathSegments = [ "api"+                                , "v1"+                                , toUrlPiece sname+                                , "removal_reasons"+                                , toUrlPiece removalReasonID+                                ]+               , method       = PUT+               , requestData  = WithForm $ toForm rr+               }++-- | Delete the given removal reason+deleteRemovalReason+    :: MonadReddit m => SubredditName -> RemovalReasonID -> m ()+deleteRemovalReason sname rrid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api"+                                , "v1"+                                , toUrlPiece sname+                                , "removal_reasons"+                                , toUrlPiece rrid+                                ]+               , method       = DELETE+               }++--Moderation listings----------------------------------------------------------+getReports, getModqueue, getSpam, getEdited, getUnmoderated+    :: MonadReddit m+    => SubredditName+    -> Paginator ItemID ModItem+    -> m (Listing ItemID ModItem)++-- | Get the given subreddit\'s reported items+getReports = modItems "reports"++-- | Get the given subreddit\'s moderation queue+getModqueue = modItems "modqueue"++-- | Get the given subreddit\'s items marked as spam+getSpam = modItems "spam"++-- | Get the given subreddit\'s recently edited items+getEdited = modItems "edited"++-- | Get the given subreddit\'s unmoderated items+getUnmoderated = modItems "unmoderated"++modItems :: MonadReddit m+         => Text+         -> SubredditName+         -> Paginator ItemID ModItem+         -> m (Listing ItemID ModItem)+modItems path sname paginator =+    runAction defaultAPIAction+              { pathSegments = subAboutPath sname path+              , requestData  = paginatorToFormData paginator+              }++-- | Get a log of moderator actions for the given subreddit+getModlog :: MonadReddit m+          => SubredditName+          -> Paginator ModActionID ModAction+          -> m (Listing ModActionID ModAction)+getModlog sname paginator =+    runAction defaultAPIAction+              { pathSegments = subAboutPath sname "log"+              , requestData  = paginatorToFormData paginator+              }++--Submission moderation--------------------------------------------------------+approveSubmission, lockSubmission, unlockSubmission+    :: MonadReddit m => SubmissionID -> m ()++-- | Approve a submission. See 'approveItem'+approveSubmission = approveItem . SubmissionItemID++-- | Lock a submission. See 'lockItem'+lockSubmission = lockItem . SubmissionItemID++-- | Unlock a submission. See 'unlockItem'+unlockSubmission = unlockItem . SubmissionItemID++ignoreSubmissionReports, unignoreSubmissionReports+    :: MonadReddit m => SubmissionID -> m ()++-- | Ignore reports for a submission. See 'ignoreItemReports'+ignoreSubmissionReports = ignoreItemReports . SubmissionItemID++-- | Resume reports for a submission. See 'unignoreItemReports'+unignoreSubmissionReports = unignoreItemReports . SubmissionItemID++-- | Distinguish a submission+distinguishSubmission :: MonadReddit m => Distinction -> SubmissionID -> m ()+distinguishSubmission how = distinguishItem how . SubmissionItemID++-- | Remove the distinction from a submission+undistinguishSubmission :: MonadReddit m => SubmissionID -> m ()+undistinguishSubmission = undistinguishItem . SubmissionItemID++-- | Sticky the submission in the subreddit+stickySubmission :: MonadReddit m+                 => Bool -- ^ When @True@, this will set the submission as+                         -- the \"bottom\" sticky. Otherwise, the stickied+                         -- submission will go to the top slot+                 -> SubmissionID+                 -> m ()+stickySubmission = stickyUnsticky True++-- | Unsticky the submission in the subreddit+unstickySubmission :: MonadReddit m => SubmissionID -> m ()+unstickySubmission = stickyUnsticky False True++stickyUnsticky :: MonadReddit m => Bool -> Bool -> SubmissionID -> m ()+stickyUnsticky state bottom sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "set_subreddit_sticky" ]+               , method       = POST+               , requestData  = mkTextFormData+                     $ [ ("id", fullname sid)+                       , ("state", toQueryParam state)+                       , ("api_type", "json")+                       ]+                     <> bool [ ("num", "1") ] mempty bottom+               }++-- | Set the suggested sort order for a submission+setSuggestedSort+    :: MonadReddit m+    => Maybe ItemSort -- ^ If @Nothing@, will clear the existing sort+    -> SubmissionID+    -> m ()+setSuggestedSort isort sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "set_suggested_sort" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("id", fullname sid)+                                    , ( "sort"+                                      , maybe "blank" toQueryParam isort+                                      )+                                    , ("api_type", "json")+                                    ]+               }++--Comment moderation-----------------------------------------------------------+-- | Distinguish aa comment. If @True@, the @sticky@ param will set the comment+-- at the top of the page. This only applies to top-level comments; the flg is+-- otherwise ignored+distinguishComment :: MonadReddit m+                   => Distinction+                   -> Bool -- ^ Sticky flag+                   -> CommentID+                   -> m ()+distinguishComment how sticky cid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "distinguish" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("id", fullname cid)+                                    , ("how", toQueryParam how)+                                    , ("sticky", toQueryParam sticky)+                                    ]+               }++-- | Undistinguish a comment, also removing its sticky flag if applicable+undistinguishComment :: MonadReddit m => CommentID -> m ()+undistinguishComment = undistinguishItem . CommentItemID++approveComment, lockComment, unlockComment+    :: MonadReddit m => CommentID -> m ()++-- | Approve a comment. See 'approveItem'+approveComment = approveItem . CommentItemID++-- | Lock a comment. See 'lockItem'+lockComment = lockItem . CommentItemID++-- | Unlock a comment. See 'unlockItem'+unlockComment = unlockItem . CommentItemID++ignoreCommentReports, unignoreCommentReports+    :: MonadReddit m => CommentID -> m ()++-- | Ignore reports for a comment. See 'ignoreItemReports'+ignoreCommentReports = ignoreItemReports . CommentItemID++-- | Resume reports for a comment. See 'unignoreItemReports'+unignoreCommentReports = unignoreItemReports . CommentItemID++-- | Show a comment that has been \"collapsed\" by crowd-control+showComment :: MonadReddit m => CommentID -> m ()+showComment cid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "show_comment" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname cid) ]+               }++-- | Create a new collection, returning the new 'Collection' upon success+createCollection :: MonadReddit m => NewCollection -> m Collection+createCollection nc =+    runAction defaultAPIAction+              { pathSegments = collectionsPath "create_collection"+              , method       = POST+              , requestData  = WithForm $ toForm nc+              }++-- | Delete the entire collection from the subreddit+deleteCollection :: MonadReddit m => CollectionID -> m ()+deleteCollection cid =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath "delete_collection"+               , method       = POST+               , requestData  = mkTextFormData [ ("collection_id", cid) ]+               }++-- | Add a submission to a collection+addSubmissionToCollection+    :: MonadReddit m => CollectionID -> SubmissionID -> m ()+addSubmissionToCollection = collectionAddRemove "add_post_to_collection"++-- | Remove a submission from a collection+removeSubmissionFromCollection+    :: MonadReddit m => CollectionID -> SubmissionID -> m ()+removeSubmissionFromCollection =+    collectionAddRemove "remove_post_in_collection"++-- | Reorder the submissions that comprise the collection by providing a+-- container of 'SubmissionID's in the new intended order+reorderCollection+    :: (MonadReddit m, Foldable t) => CollectionID -> t SubmissionID -> m ()+reorderCollection cid ss =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath "reorder_collection"+               , method       = POST+               , requestData  = mkTextFormData [ ("collection_id", cid)+                                               , ("link_ids", fullname ss)+                                               ]+               }++-- | Update the description of the collection+updateCollectionDescription :: MonadReddit m => CollectionID -> Body -> m ()+updateCollectionDescription cid b =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath "update_collection_description"+               , method       = POST+               , requestData  = mkTextFormData [ ("collection_id", cid)+                                               , ("description", b)+                                               ]+               }++-- | Update the title of the collection+updateCollectionTitle :: MonadReddit m => CollectionID -> Title -> m ()+updateCollectionTitle cid t =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath "update_collection_title"+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("collection_id", cid), ("title", t) ]+               }++collectionAddRemove+    :: MonadReddit m => PathSegment -> CollectionID -> SubmissionID -> m ()+collectionAddRemove path cid sid =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath path+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("collection_id", cid)+                                    , ("link_fullname", fullname sid)+                                    ]+               }++collectionsPath :: PathSegment -> [PathSegment]+collectionsPath path = [ "api", "v1", "collections", path ]++--Subreddit relationships------------------------------------------------------+-- | Get a list of information on all moderators for the given subreddit+getModerators :: MonadReddit m => SubredditName -> m (Seq ModAccount)+getModerators sname = runAction @ModList r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = subAboutPath sname "moderators" }++-- | Get information about a single moderator, if such a moderator exists+getModerator+    :: MonadReddit m => SubredditName -> Username -> m (Maybe ModAccount)+getModerator sname uname = do+    mods <- runAction @ModList r <&> wrappedTo+    case mods of+        modInfo :<| _ -> pure $ Just modInfo+        _             -> pure Nothing+  where+    r = defaultAPIAction+        { pathSegments = subAboutPath sname "moderators"+        , requestData  = mkTextFormData [ ("user", toQueryParam uname) ]+        }++-- | Update the permissions granted to a current moderator+updateModerator+    :: (MonadReddit m, Foldable t)+    => Maybe (t ModPermission)+    -- ^ If @Nothing@, grants all permissions. If @Just@ and empty,+    -- all permissions are revoked. Otherwise, each of the given container+    -- of permissions is granted+    -> SubredditName+    -> Username+    -> m ()+updateModerator = postUpdate Mod++-- | Revoke the given user\'s mod status+removeModerator :: MonadReddit m => SubredditName -> Username -> m ()+removeModerator = postUnfriend Mod++-- | Revoke the authenticated user\'s mod status in the given subreddit.+-- __Caution__!+abdicateModerator :: MonadReddit m => SubredditName -> m ()+abdicateModerator sname = do+    Account { username } <- getMe+    postUnfriend Mod sname username++-- | Invite a user to moderate the subreddit. This action will implicitly grant+-- the invitee all moderator permissions on the subreddit. To control which+-- specific set of permissions the invitee shall be allowed instead, see+-- 'inviteModeratorWithPerms'+inviteModerator :: MonadReddit m => SubredditName -> Username -> m ()+inviteModerator = invite $ mkTextForm [ ("permissions", "+all") ]++-- | Invite a user to moderate the subreddit with a specific set of permissions+inviteModeratorWithPerms+    :: (MonadReddit m, Foldable t)+    => t ModPermission -- ^ If empty, no permissions are granted+    -> SubredditName+    -> Username+    -> m ()+inviteModeratorWithPerms perms =+    invite $ mkTextForm [ ("permissions", joinPerms perms) ]++invite :: MonadReddit m => Form -> SubredditName -> Username -> m ()+invite = postFriend ModInvitation++-- | Get a listing of users invited to moderate the subreddit. This endpoint only+-- returns 25 results at a time, and does not use the @Listing@ mechanism that+-- prevails elsewhere. You can paginate through all invitees by passing previous+-- 'ModInviteeList' results to subsequent invocations+getInvitees :: MonadReddit m+            => Maybe ModInviteeList+            -- ^ A previously obtained 'ModInviteeList' that may contain+            -- @before@ and @after@ fields to paginate through entries+            -> SubredditName+            -> m ModInviteeList+getInvitees mil sname =+    runAction defaultAPIAction+              { pathSegments =+                    [ "api", "v1", toUrlPiece sname, "moderators_invited" ]+              , requestData  = WithForm $ maybe mempty toForm mil+              }++-- | Get information about a single invited user+getInvitee+    :: MonadReddit m => SubredditName -> Username -> m (Maybe ModInvitee)+getInvitee sname uname = do+    ModInviteeList { invited } <- runAction r+    case invited of+        invitee :<| _ -> pure $ Just invitee+        _             -> pure Nothing+  where+    r = defaultAPIAction+        { pathSegments =+              [ "api", "v1", toUrlPiece sname, "moderators_invited" ]+        , requestData  = mkTextFormData [ ("username", toQueryParam uname) ]+        }++-- | Update the permissions granted to the mod invitee+updateInvitation+    :: (MonadReddit m, Foldable t)+    => Maybe (t ModPermission)+    -- ^ If @Nothing@, grants all permissions. If @Just@ and empty,+    -- all permissions are revoked. Otherwise, each of the given container+    -- of permissions is granted+    -> SubredditName+    -> Username+    -> m ()+updateInvitation = postUpdate ModInvitation++postUpdate :: (MonadReddit m, Foldable t)+           => SubredditRelationship+           -> Maybe (t ModPermission)+           -> SubredditName+           -> Username+           -> m ()+postUpdate ty ps sname uname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "setpermissions"+               , method       = POST+               , requestData  = mkTextFormData [ ("name", toQueryParam uname)+                                               , ("type", toQueryParam ty)+                                               , ( "permissions"+                                                 , maybe "+all" joinPerms ps+                                                 )+                                               , ("api_type", "json")+                                               ]+               }++-- | Revoke an existing moderator invitation for the given user+revokeInvitation :: MonadReddit m => SubredditName -> Username -> m ()+revokeInvitation = postUnfriend ModInvitation++-- | Accept the invitation issued to the authenticated user to moderate the+-- given subreddit+acceptInvitation :: MonadReddit m => SubredditName -> m ()+acceptInvitation sname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "accept_moderator_invitation"+               , method       = POST+               , requestData  = mkTextFormData [ ("api_type", "json") ]+               }++-- | Get a list of contributors on the subreddit+getContributors :: MonadReddit m+                => SubredditName+                -> Paginator RelID RelInfo+                -> m (Listing RelID RelInfo)+getContributors = relListing Contributor++-- | Get a single contributor, if such a user exists+getContributor+    :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)+getContributor = singleRel getContributors++-- | Give a user contributor status on the subreddit+addContributor :: MonadReddit m => SubredditName -> Username -> m ()+addContributor = postFriend Contributor mempty++-- | Remove a contributor from the subreddit+removeContributor :: MonadReddit m => SubredditName -> Username -> m ()+removeContributor = postUnfriend Contributor++-- | AbdicateModerator your contributor status on the given subreddit+abdicateContributor :: MonadReddit m => SubredditID -> m ()+abdicateContributor sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "leavecontributor" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname sid) ]+               }++-- | Get a list of wiki contributors on the subreddit+getWikiContributors :: MonadReddit m+                    => SubredditName+                    -> Paginator RelID RelInfo+                    -> m (Listing RelID RelInfo)+getWikiContributors = relListing WikiContributor++-- | Get a single wiki contributor, if such a user exists+getWikiContributor+    :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)+getWikiContributor = singleRel getWikiContributors++-- | Give a user wiki contributor privileges on the subreddit+addWikiContributor :: MonadReddit m => SubredditName -> Username -> m ()+addWikiContributor = postFriend WikiContributor mempty++-- | Revoke wiki contributor privileges on the subreddit+removeWikiContributor :: MonadReddit m => SubredditName -> Username -> m ()+removeWikiContributor = postUnfriend WikiContributor++-- | Get the banned users for a given subreddit+getBans :: MonadReddit m+        => SubredditName+        -> Paginator RelID Ban+        -> m (Listing RelID Ban)+getBans = relListing Banned++-- | Check to see if a given user is banned on a particular subreddit,+-- returning the details of the 'Ban' if so+getBan :: MonadReddit m => SubredditName -> Username -> m (Maybe Ban)+getBan = singleRel getBans++-- | Issue a ban against a user on the given subreddit, with the provided notes+-- and (optional) duration+banUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()+banUser ban = postFriend Banned (toForm ban)++-- | Remove an existing ban on a user+unbanUser :: MonadReddit m => SubredditName -> Username -> m ()+unbanUser = postUnfriend Banned++-- | Ban a user from participating in the wiki+wikibanUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()+wikibanUser ban = postFriend BannedFromWiki (toForm ban)++-- | Reverse an existing wiki ban for a user+wikiUnbanUser :: MonadReddit m => SubredditName -> Username -> m ()+wikiUnbanUser = postUnfriend BannedFromWiki++-- | Get a list of users banned on the subreddit wiki+getWikibans :: MonadReddit m+            => SubredditName+            -> Paginator RelID RelInfo+            -> m (Listing RelID RelInfo)+getWikibans = relListing BannedFromWiki++-- | Get information on a single user banned on the subreddit wiki, if such a ban+-- exists+getWikiban :: MonadReddit m => SubredditName -> Username -> m (Maybe RelInfo)+getWikiban = singleRel getWikibans++-- | Get a list of users muted on the subreddit wiki+getMuted :: MonadReddit m+         => SubredditName+         -> Paginator MuteID MuteInfo+         -> m (Listing MuteID MuteInfo)+getMuted = relListing Muted++-- | Get information on a single user muted on the subreddit wiki, if such a ban+-- exists+getMutedUser+    :: MonadReddit m => SubredditName -> Username -> m (Maybe MuteInfo)+getMutedUser = singleRel getMuted++-- | Mute a single user on the subreddit+muteUser :: MonadReddit m => BanNotes -> SubredditName -> Username -> m ()+muteUser ban = postFriend Muted (toForm ban)++-- | Unmute a single user on the subreddit+unmuteUser :: MonadReddit m => SubredditName -> Username -> m ()+unmuteUser = postUnfriend Muted++postFriend :: MonadReddit m+           => SubredditRelationship+           -> Form+           -> SubredditName+           -> Username+           -> m ()+postFriend ty form sname uname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "friend"+               , method       = POST+               , requestData  = WithForm+                     $ mkTextForm [ ("name", toQueryParam uname)+                                  , ("type", toQueryParam ty)+                                  , ("api_type", "json")+                                  ]+                     <> form+               }++postUnfriend :: MonadReddit m+             => SubredditRelationship+             -> SubredditName+             -> Username+             -> m ()+postUnfriend ty sname uname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "unfriend"+               , method       = POST+               , requestData  = mkTextFormData [ ("name", toQueryParam uname)+                                               , ("type", toQueryParam ty)+                                               , ("api_type", "json")+                                               ]+               }++relListing :: (MonadReddit m, FromJSON a, Paginable a, FromJSON t, Thing t)+           => SubredditRelationship+           -> SubredditName+           -> Paginator t a+           -> m (Listing t a)+relListing ty sname paginator =+    runAction defaultAPIAction+              { pathSegments = subAboutPath sname (toUrlPiece ty)+              , requestData  = paginatorToFormData paginator+              }++singleRel :: forall m a t.+          (MonadReddit m, Paginable a, PaginateOptions a ~ RelInfoOpts)+          => (SubredditName -> Paginator t a -> m (Listing t a))+          -> SubredditName+          -> Username+          -> m (Maybe a)+singleRel action sname uname = do+    Listing { children } <- action sname pag+    case children of+        child :<| _ -> pure $ Just child+        _           -> pure Nothing+  where+    pag = (emptyPaginator @t @a)+        { opts = RelInfoOpts { username = Just uname } }++--Subreddit settings-----------------------------------------------------------+-- | Get the configured 'SubredditSettings' for a given subreddit+getSubredditSettings :: MonadReddit m => SubredditName -> m SubredditSettings+getSubredditSettings sname =+    runAction defaultAPIAction { pathSegments = subAboutPath sname "edit" }++-- | 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+        }++--Subreddit rules--------------------------------------------------------------+-- | Add a rule to the subreddit. The newly created 'SubredditRule' is returned+-- upon success+addSubredditRule+    :: MonadReddit m => SubredditName -> NewSubredditRule -> m SubredditRule+addSubredditRule sname nsr = runAction @PostedSubredditRule r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "add_subreddit_rule" ]+        , method       = POST+        , requestData  = WithForm+              $ mkTextForm [ ("r", toQueryParam sname), ("api_type", "json") ]+              <> toForm nsr+        }++-- | Delete the rule identified by the given name from the subreddit+deleteSubredditRule :: MonadReddit m => SubredditName -> Name -> m ()+deleteSubredditRule sname n =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "remove_subreddit_rule" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("r", toQueryParam sname)+                                               , ("short_name", n)+                                               ]+               }++-- | Update an existing subreddit rule. You must provide the @shortName@ of the+-- existing rule as a parameter in order for Reddit to identify the rule. The+-- @shortName@ can be changed by updating the 'SubredditRule' record, however+updateSubredditRule+    :: MonadReddit m+    => SubredditName+    -> Name+    -- ^ The old name for the rule. This is required even if you are not+    -- changing the name of the rule, as Reddit has no other data to+    -- uniquely identify the rule+    -> SubredditRule+    -> m SubredditRule+updateSubredditRule sname oldName srule =+    runAction @PostedSubredditRule r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "update_subreddit_rule" ]+        , method       = POST+        , requestData  = WithForm+              $ mkTextForm [ ("old_short_name", oldName)+                           , ("r", toQueryParam sname)+                           , ("api_type", "json")+                           ]+              <> toForm srule+        }++-- | Reorder the subreddit rules+reorderSubredditRules+    :: (MonadReddit m, Foldable t)+    => SubredditName+    -> t Name+    -- ^ The desired order of the rules. Must contain all of the @shortName@s+    -- of currently configured 'SubredditRule's on the subreddit+    -> m ()+reorderSubredditRules sname ns =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "reorder_subreddit_rules" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("r", toQueryParam sname)+                                    , ("new_rule_order", joinParams ns)+                                    ]+               }++--Flair------------------------------------------------------------------------+-- | Get a list of usernames and the flair currently assigned to them+getFlairList :: MonadReddit m+             => SubredditName+             -> Paginator UserID AssignedFlair+             -> m (Listing UserID AssignedFlair)+getFlairList sname paginator = flairlistToListing+    <$> runAction defaultAPIAction+                  { pathSegments = subAPIPath sname "flairlist"+                  , requestData  = paginatorToFormData paginator+                  }++-- | Get the 'UserFlair' that corresponds to a 'Username'+getUserFlair+    :: MonadReddit m => SubredditName -> Username -> m (Maybe UserFlair)+getUserFlair sname uname = catch @_ @APIException action $ \case+    JSONParseError _ _ -> pure Nothing+    e                  -> throwM e+  where+    action = runAction @CurrentUserFlair r <&> Just . wrappedTo++    r      = defaultAPIAction+        { pathSegments = subAPIPath sname "flairselector"+        , method       = POST+        , requestData  = mkTextFormData [ ("name", toQueryParam uname) ]+        }++-- | Set a user\'s flair. If the 'CSSClass' is provided in the 'FlairChoice', it+-- takes precedence over the 'FlairID' contained in that record+setUserFlair :: MonadReddit m => FlairSelection -> Username -> m ()+setUserFlair (FlairSelection FlairChoice { .. } txt sname) uname =+    runAction_ route+  where+    route     = case cssClass of+        Just css -> baseRoute+            { pathSegments = subAPIPath sname "selectflair"+            , requestData  = WithForm+                  $ baseForm <> mkTextForm [ ("css_class", toQueryParam css) ]+            }+        Nothing  -> baseRoute+            { pathSegments = subAPIPath sname "flair"+            , requestData  = WithForm+                  $ baseForm+                  <> mkTextForm [ ( "flair_template_id"+                                  , toQueryParam templateID+                                  )+                                ]+            }++    baseForm  = mkTextForm+        $ [ ("name", toQueryParam uname) ]+        <> foldMap pure (("text", ) <$> txt)++    baseRoute = defaultAPIAction { method = POST }++-- | Set, update, or deleteSRImage the flair of multiple users at once, given a+-- container of 'AssignedFlair's+setUserFlairs :: (MonadReddit m, Foldable t)+              => SubredditName+              -> t AssignedFlair+              -> m (Seq FlairResult)+setUserFlairs sname afs = mconcat+    <$> traverse (runAction . r) (chunksOf apiRequestLimit (F.toList afs))+  where+    r as = defaultAPIAction+        { pathSegments = subAPIPath sname "flaircsv"+        , method       = POST+        , requestData  =+              mkTextFormData [ ("flair_csv", T.unlines $ mkRow <$> as) ]+        }++    mkRow AssignedFlair { .. } =+        joinParams [ toQueryParam user+                   , maybe mempty toQueryParam text+                   , toQueryParam $ fromMaybe mempty cssClass+                   ]++-- | Delete a user\'s flair on the given subreddit+deleteUserFlair :: MonadReddit m => SubredditName -> Username -> m ()+deleteUserFlair sname uname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "deleteflair"+               , method       = POST+               , requestData  = mkTextFormData [ ("name", toQueryParam uname)+                                               , ("api_type", "json")+                                               ]+               }++-- | Create a new 'FlairTemplate' for either users or submissions, returning the+-- newly created template+createFlairTemplate :: MonadReddit m+                    => FlairType+                    -> SubredditName+                    -> FlairTemplate+                    -> m FlairTemplate+createFlairTemplate fty sname tmpl = runAction+    $ flairRoute (toForm tmpl) fty sname++-- | Create a new 'FlairTemplate' for users, returning the newly created template+createUserFlairTemplate+    :: MonadReddit m => SubredditName -> FlairTemplate -> m FlairTemplate+createUserFlairTemplate = createFlairTemplate UserFlairType++-- | Create a new 'FlairTemplate' for submissions, returning the newly created+-- template+createSubmissionFlairTemplate+    :: MonadReddit m => SubredditName -> FlairTemplate -> m FlairTemplate+createSubmissionFlairTemplate = createFlairTemplate SubmissionFlairType++-- | Update an existing 'FlairTemplate' for either users or submissions+updateFlairTemplate+    :: MonadReddit m => FlairType -> SubredditName -> FlairTemplate -> m ()+updateFlairTemplate fty sname tmpl = runAction_ $ flairRoute form fty sname+  where+    form = toForm $ wrappedFrom @PostedFlairTemplate tmpl++-- | Update an existing 'FlairTemplate' for users+updateUserFlairTemplate+    :: MonadReddit m => SubredditName -> FlairTemplate -> m ()+updateUserFlairTemplate = updateFlairTemplate UserFlairType++-- | Update an existing 'FlairTemplate' for submissions+updateSubmissionFlairTemplate+    :: MonadReddit m => SubredditName -> FlairTemplate -> m ()+updateSubmissionFlairTemplate = updateFlairTemplate SubmissionFlairType++flairRoute :: Form -> FlairType -> SubredditName -> APIAction a+flairRoute form fty sname = defaultAPIAction+    { pathSegments = subAPIPath sname "flairtemplate_v2"+    , method       = POST+    , requestData  =+          WithForm $ form <> mkTextForm [ ("flair_type", toQueryParam fty) ]+    }++-- | Delete a user or submission flair template given its 'FlairID'+deleteFlairTemplate :: MonadReddit m => SubredditName -> FlairID -> m ()+deleteFlairTemplate sname ftid =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "deleteflairtemplate"+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("flair_template_id", toQueryParam ftid)+                                    ]+               }++-- | Clear all of the user flair templates on the subreddit+clearUserFlairTemplates :: MonadReddit m => SubredditName -> m ()+clearUserFlairTemplates = clearFlairTemplates UserFlairType++-- | Clear all of the user flair templates on the subreddit+clearSubmissionFlairTemplates :: MonadReddit m => SubredditName -> m ()+clearSubmissionFlairTemplates = clearFlairTemplates SubmissionFlairType++-- | Clear all of the user or submission flair templates on the subreddit+clearFlairTemplates :: MonadReddit m => FlairType -> SubredditName -> m ()+clearFlairTemplates fty sname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "clearflairtemplates"+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("flair_type", toQueryParam fty) ]+               }++--Wikis------------------------------------------------------------------------+-- | Get the 'WikiPageSettings' for the subreddit\'s given wikipage+getWikiPageSettings+    :: MonadReddit m => SubredditName -> WikiPageName -> m WikiPageSettings+getWikiPageSettings sname wpage =+    runAction defaultAPIAction+              { pathSegments = [ "r"+                               , toUrlPiece sname+                               , "wiki"+                               , "settings"+                               , toQueryParam wpage+                               ]+              }++-- | Grant editing privileges to the given 'Username' on the subreddit\'s wikipage+addWikiEditor+    :: MonadReddit m => SubredditName -> WikiPageName -> Username -> m ()+addWikiEditor = allowedEditor "add"++-- | Revoke the given 'Username'\'s editing privileges on the subreddit\'s wikipage+removeWikiEditor+    :: MonadReddit m => SubredditName -> WikiPageName -> Username -> m ()+removeWikiEditor = allowedEditor "del"++allowedEditor :: MonadReddit m+              => Text+              -> SubredditName+              -> WikiPageName+              -> Username+              -> m ()+allowedEditor path sname wpage uname =+    runAction_ defaultAPIAction+               { pathSegments = [ "r"+                                , toQueryParam sname+                                , "api"+                                , "wiki"+                                , "allowededitor"+                                , path+                                ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("page", toQueryParam wpage)+                                    , ("username", toQueryParam uname)+                                    ]+               }++-- | Revert the wikipage to the given revision+revertWikiPage :: MonadReddit m+               => SubredditName+               -> WikiPageName+               -> WikiRevisionID+               -> m ()+revertWikiPage sname wpage wr =+    runAction_ defaultAPIAction+               { pathSegments =+                     [ "r", toUrlPiece sname, "api", "wiki", "revert" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("page", toQueryParam wpage)+                                               , ("revision", toQueryParam wr)+                                               ]+               }++--Stylesheets, images and widgets ----------------------------------------------+-- | Get the 'Stylesheet' that has been configured for the given subreddit+getStylesheet :: MonadReddit m => SubredditName -> m Stylesheet+getStylesheet sname =+    runAction defaultAPIAction+              { pathSegments =+                    [ "r", toUrlPiece sname, "about", "stylesheet" ]+              }++-- | Update a given subreddit\'s stylesheet with new contents, which must be+-- valid CSS+updateStylesheet :: MonadReddit m+                 => SubredditName+                 -> Maybe Text -- ^ The reason for the change, if any+                 -> Text -- ^ The new contents of the stylesheet+                 -> m ()+updateStylesheet sname r contents =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "subreddit_stylesheet"+               , method       = POST+               , requestData  = mkTextFormData+                     $ [ ("stylesheet_contents", contents)+                       , ("op", "save")+                       , ("api_type", "json")+                       ]+                     <> foldMap pure (("reason", ) <$> r)+               }++uploadImage, uploadHeader+    :: MonadReddit m => Text -> FilePath -> SubredditName -> m ()++-- | Upload an image file to add to the given subreddit\'s stylesheet+uploadImage = uploadSRImage "img"++-- | Upload the image header for the given subreddit\'s stylesheet+uploadHeader = uploadSRImage "header"++uploadMobileIcon, uploadMobileHeader+    :: MonadReddit m => Text -> FilePath -> SubredditName -> m ()++-- | Upload a mobile icon for the given subreddit+uploadMobileIcon = uploadSRImage "icon"++-- | Upload the mobile header for the given subreddit+uploadMobileHeader = uploadSRImage "banner"++-- | Delete the named image from the given subreddit\'s stylesheet+deleteImage :: MonadReddit m => Text -> SubredditName -> m ()+deleteImage = deleteSRImage "img"++-- | Delete the named image from the given subreddit\'s stylesheet+deleteMobileIcon :: MonadReddit m => Text -> SubredditName -> m ()+deleteMobileIcon = deleteSRImage "icon"++-- | Delete header image from the given subreddit+deleteHeader :: MonadReddit m => SubredditName -> m ()+deleteHeader sname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "delete_sr_header"+               , method       = POST+               , requestData  = mkTextFormData [ ("api_type", "json") ]+               }++-- | Upload a banner for the subreddit (redesign only)+uploadBanner :: MonadReddit m => SubredditName -> FilePath -> m ()+uploadBanner sname fp = do+    imgURL <- uploadS3Asset sname BannerBackground fp+    updateStructuredStyles sname+        $ mkTextForm [ (toQueryParam BannerBackground, imgURL) ]++-- | Delete the subreddit banner, even if it does not exist (redesign only)+deleteBanner :: MonadReddit m => SubredditName -> m ()+deleteBanner sname = updateStructuredStyles sname+    $ mkTextForm [ (toQueryParam BannerBackground, mempty) ]++-- | Upload the additional image banner for the subreddit (redesign only)+uploadBannerAdditional+    :: MonadReddit m+    => Maybe StyleImageAlignment+    -> SubredditName+    -> FilePath+    -> m ()+uploadBannerAdditional sia sname fp = do+    imgURL <- uploadS3Asset sname BannerAdditional fp+    updateStructuredStyles sname . mkTextForm+        $ [ (toQueryParam BannerAdditional, imgURL) ]+        <> foldMap pure+                   (("bannerPositionedImagePosition", ) . toQueryParam <$> sia)++-- | Delete all additional banners, including the hover banner (redesign only)+deleteBannerAdditional :: MonadReddit m => SubredditName -> m ()+deleteBannerAdditional sname = updateStructuredStyles sname+    $ mkTextForm [ (toQueryParam BannerAdditional, mempty)+                 , (toQueryParam BannerHover, mempty)+                 ]++-- | Upload the banner hover image for the subreddit (redesign only)+uploadBannerHover :: MonadReddit m => SubredditName -> FilePath -> m ()+uploadBannerHover sname fp = do+    imgURL <- uploadS3Asset sname BannerHover fp+    updateStructuredStyles sname+        $ mkTextForm [ (toQueryParam BannerHover, imgURL) ]++-- | Delete the subreddit banner hover image (redesign only)+deleteBannerHover :: MonadReddit m => SubredditName -> m ()+deleteBannerHover sname = updateStructuredStyles sname+    $ mkTextForm [ (toQueryParam BannerHover, mempty) ]++uploadSRImage :: forall m.+              MonadReddit m+              => ByteString+              -> Text+              -> FilePath+              -> SubredditName+              -> m ()+uploadSRImage ty name fp sname = withSourceFile @_ @m fp $ \bs -> do+    img <- runConduit $ bs .| sinkLbs+    imageType <- getImageType img+    when (LB.length img > maxImageSize) . throwM+        $ InvalidRequest "uploadSRImage: exceeded maximum image size"+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "upload_sr_img"+               , method       = POST+               , requestData  =+                     WithMultipart [ partBS "img_type" imageType+                                     -- This seems to work, but @partLBS img@ causes+                                     -- reddit to freak out+                                   , partFile "file" fp+                                   , partBS "name" $ T.encodeUtf8 name+                                   , partBS "upload_type" ty+                                   , partBS "api_type" "json"+                                   ]+               }+  where+    maxImageSize = 512000++    getImageType = \case+        bs+            | LB.take 4 (LB.drop 6 bs) == "JFIF" -> pure "jpeg"+            | LB.isPrefixOf "\137PNG\r\n\26\n" bs -> pure "png"+            | otherwise -> throwM+                $ InvalidRequest "uploadSRImage: Can't detect image type"++deleteSRImage :: MonadReddit m => Text -> Text -> SubredditName -> m ()+deleteSRImage path name sname =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname $ "delete_sr_" <> path+               , method       = POST+               , requestData  = mkTextFormData [ ("img_name", name)+                                               , ("api_type", "json")+                                               ]+               }++uploadS3Asset :: MonadReddit m+              => SubredditName+              -> StructuredStyleImage+              -> FilePath+              -> m URL+uploadS3Asset sname imageType fp = do+    mimetype <- case FP.takeExtension fp of+        ext+            | ext `elem` [ ".jpeg", ".jpg" ] -> pure "image/jpeg"+            | ext == ".png" -> pure "image/png"+            | otherwise ->+                throwM $ InvalidRequest "uploadS3Asset: invalid file type"+    S3ModerationLease { .. }+        <- runAction defaultAPIAction+                     { pathSegments = [ "api"+                                      , "v1"+                                      , "style_asset_upload_s3"+                                      , toUrlPiece sname+                                      ]+                     , method       = POST+                     , requestData  = mkTextFormData [ ( "filepath"+                                                       , toQueryParam+                                                         $ FP.takeFileName fp+                                                       )+                                                     , ("mimetype", mimetype)+                                                     , ( "imagetype"+                                                       , toQueryParam imageType+                                                       )+                                                     ]+                     }+    (url, ps) <- splitURL action+    void . runActionWith_+        =<< mkRequest url+                      defaultAPIAction+                      { pathSegments = ps+                      , method       = POST+                      , requestData  = WithMultipart+                            $ HM.foldrWithKey mkParts+                                              [ partFile "file" fp ]+                                              fields+                      , rawJSON      = False+                      }+    pure $ T.intercalate "/" [ action, key ]+  where+    mkParts name value ps = partBS name (T.encodeUtf8 value) : ps++updateStructuredStyles :: MonadReddit m => SubredditName -> Form -> m ()+updateStructuredStyles sname form =+    runAction_ defaultAPIAction+               { pathSegments =+                     [ "api", "v1", "structured_styles", toUrlPiece sname ]+               , method       = PATCH+               , requestData  = WithForm form+               }++--Modmail----------------------------------------------------------------------+-- | Get all of the authenticated user\'s modmail. See 'getModmailWithOpts' in+-- order to control how modmail is sorted or filtered+getModmail :: MonadReddit m => m Modmail+getModmail =+    runAction defaultAPIAction+              { pathSegments = modmailPath+              , requestData  = WithForm+                    $ toForm defaultModmailOpts { state = Just AllModmail }+              }++-- | Get the authenticated user\'s modmail with the provided 'ModmailOpts'+getModmailWithOpts :: MonadReddit m => ModmailOpts -> m Modmail+getModmailWithOpts opts =+    runAction defaultAPIAction+              { pathSegments = modmailPath+              , requestData  = WithForm $ toForm opts+              }++-- | Get a single 'ModmailConversation' given its ID+getModmailConversation :: MonadReddit m => ModmailID -> m ModmailConversation+getModmailConversation m = runAction @ConversationDetails r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = modmailPath <> [ toUrlPiece m ] }++-- | Get the number of unread modmail conversations according to conversation+-- state+getUnreadModmailCount :: MonadReddit m => m (HashMap ModmailState Word)+getUnreadModmailCount =+    runAction defaultAPIAction+              { pathSegments = modmailPath <> [ "unread", "count" ] }++-- | Create a new 'ModmailConversation'+createConversation+    :: MonadReddit m => NewConversation -> m ModmailConversation+createConversation nc = runAction @ConversationDetails r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = modmailPath+        , method       = POST+        , requestData  = WithForm $ toForm nc+        }++-- | Reply to the modmail conversation+replyToConversation+    :: MonadReddit m => ModmailReply -> ModmailID -> m ModmailConversation+replyToConversation mr m = runAction @ConversationDetails r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = modmailPath <> [ toUrlPiece m ]+        , method       = POST+        , requestData  = WithForm $ toForm mr+        }++-- | Archive a modmail conversation+archiveConversation :: MonadReddit m => ModmailID -> m ()+archiveConversation m =+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ toUrlPiece m, "archive" ]+               , method       = POST+               }++-- | Archive a modmail conversation+unarchiveConversation :: MonadReddit m => ModmailID -> m ()+unarchiveConversation m =+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ toUrlPiece m, "unarchive" ]+               , method       = POST+               }++-- | Highlight a given conversation+highlightConversation :: MonadReddit m => ModmailID -> m ()+highlightConversation = highlightUnhighlight POST++-- | Unhighlight a given conversation+unhighlightConversation :: MonadReddit m => ModmailID -> m ()+unhighlightConversation = highlightUnhighlight DELETE++highlightUnhighlight :: MonadReddit m => Method -> ModmailID -> m ()+highlightUnhighlight method m =+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ toUrlPiece m, "highlight" ]+               , method+               }++-- | Mark the conversations corresponding to a container of 'ModmailID's as read+markConversationsRead :: (Foldable t, MonadReddit m) => t ModmailID -> m ()+markConversationsRead = readUnread "read"++-- | Mark the conversation corresponding to a single 'ModmailID' as read+markConversationRead :: MonadReddit m => ModmailID -> m ()+markConversationRead m = markConversationsRead [ m ]++-- | Mark the conversations corresponding to a container of 'ModmailID's as unread+markConversationsUnread :: (Foldable t, MonadReddit m) => t ModmailID -> m ()+markConversationsUnread = readUnread "unread"++-- | Mark the conversation corresponding to a single 'ModmailID' as unread+markConversationUnread :: MonadReddit m => ModmailID -> m ()+markConversationUnread m = markConversationsUnread [ m ]++readUnread+    :: (Foldable t, MonadReddit m) => PathSegment -> t ModmailID -> m ()+readUnread path ms =+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ path ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("conversationIds", joinParams ms) ]+               }++-- | Mark all mail belonging to the subreddits as read, returning the 'ModmailID's+-- of the newly read conversations+bulkReadConversations :: (MonadReddit m, Foldable t)+                      => Maybe ModmailState+                      -> t SubredditName+                      -> m (Seq ModmailID)+bulkReadConversations mms snames = runAction @BulkReadIDs r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = modmailPath <> [ "bulk", "read" ]+        , method       = POST+        , requestData  = WithForm . mkTextForm+              $ [ ("entity", joinParams snames) ]+              <> foldMap pure (("state", ) . toQueryParam <$> mms)+        }++-- | Mute the non-moderator user associated with the modmail conversation. Valid+-- durations for the @days@ parameter are 3, 7, and 28+muteModmailUser :: MonadReddit m => Word -> ModmailID -> m ()+muteModmailUser days m = do+    when (days `notElem` [ 3, 7, 28 ]) . throwM+        $ InvalidRequest --+        "muteModmailUser: mute duration must be one of 3, 7, or 28"+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ toUrlPiece m, "mute" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("num_hours", toQueryParam $ days * 24)+                                    ]+               }++-- | Unmute the non-moderator user associated with the modmail conversation+unmuteModmailUser :: MonadReddit m => ModmailID -> m ()+unmuteModmailUser m =+    runAction_ defaultAPIAction+               { pathSegments = modmailPath <> [ toUrlPiece m, "unmute" ]+               , method       = POST+               }++modmailPath :: [PathSegment]+modmailPath = [ "api", "mod", "conversations" ]++--Widgets----------------------------------------------------------------------+-- | Delete a widget, given its ID+deleteWidget :: MonadReddit m => SubredditName -> WidgetID -> m ()+deleteWidget sname wid =+    runAction_ defaultAPIAction+               { pathSegments =+                     subAPIPath sname "widget" <> [ toUrlPiece wid ]+               , method       = DELETE+               }++-- | Reorder the widgets corresponding to a container of widget IDs in the given+-- section. At the moment, reddit does not allow for the 'Topbar' to be reordered.+-- If you attempt to reorder this section, you might receive an 'InvalidJSON'+-- exception+reorderWidgets :: (MonadReddit m, Foldable t)+               => Maybe WidgetSection+               -> SubredditName+               -> t WidgetID+               -> m ()+reorderWidgets sm sname ws =+    runAction_ defaultAPIAction+               { pathSegments =+                     subAPIPath sname "widget_order" <> [ toUrlPiece section ]+               , method       = PATCH+               , requestData  =+                     mkTextFormData [ ("json", textEncode $ F.toList ws)+                                    , ("section", toQueryParam section)+                                    ]+               }+  where+    section = fromMaybe Sidebar sm++-- | Update an existing widget, given its ID. You must wrap the widget type in+-- the appropriate 'Widget' constructors, as this action may be performed on+-- heterogeneous widget types. The update widget is returned upon success+updateWidget+    :: MonadReddit m => SubredditName -> WidgetID -> Widget -> m Widget+updateWidget sname wid w =+    runAction defaultAPIAction+              { pathSegments = subAPIPath sname "widget" <> [ toUrlPiece wid ]+              , method       = PUT+              , requestData  = mkTextFormData [ ("json", textEncode w) ]+              }++-- | Add a button widget. Returns the created widget upon success. See the docs for+-- 'ButtonWidget' for the available options+addButtonWidget+    :: MonadReddit m => SubredditName -> ButtonWidget -> m ButtonWidget+addButtonWidget = addNormalWidget++-- | Add a calendar widget, which requires an active Google account and public+-- calendar. Returns the created widget upon success. See the docs for+-- 'CalendarWidget' for the available options+addCalendarWidget+    :: MonadReddit m+    => Maybe Body -- ^ A short description of the widget, in markdown+    -> SubredditName+    -> CalendarWidget+    -> m CalendarWidget+addCalendarWidget = addDescribableWidget++-- | Add a community list widget. Returns the created widget upon success. See+-- the docs for 'CommunityListWidget' for the available options+addCommunityListWidget+    :: MonadReddit m+    => Maybe Body -- ^ A short description of the widget, in markdown+    -> SubredditName+    -> CommunityListWidget+    -> m CommunityListWidget+addCommunityListWidget = addDescribableWidget++-- | Add a custom widget. Returns the created widget upon success. See+-- the docs for 'CustomWidget' for the available options+addCustomWidget+    :: MonadReddit m => SubredditName -> CustomWidget -> m CustomWidget+addCustomWidget = addNormalWidget++-- | Add an image widget. Returns the created widget upon success. See+-- the docs for 'ImageWidget' for the available options+addImageWidget+    :: MonadReddit m => SubredditName -> ImageWidget -> m ImageWidget+addImageWidget = addNormalWidget++-- | Add a menu widget. Returns the created widget upon success. See+-- the docs for 'MenuWidget' for the available options+addMenuWidget :: MonadReddit m => SubredditName -> MenuWidget -> m MenuWidget+addMenuWidget = addNormalWidget++-- | Add a post flair widget. Returns the created widget upon success. See+-- the docs for 'PostFlairWidget' for the available options along with+-- 'mkPostFlairWidget'+addPostFlairWidget+    :: MonadReddit m => SubredditName -> PostFlairWidget -> m PostFlairWidget+addPostFlairWidget = addNormalWidget++-- | Add a text area widget. Returns the created widget upon success. See+-- the docs for 'TextAreaWidget' for the available options as well as+-- 'mkTextAreaWidget'+addTextAreaWidget+    :: MonadReddit m => SubredditName -> TextAreaWidget -> m TextAreaWidget+addTextAreaWidget = addNormalWidget++addNormalWidget+    :: (MonadReddit m, ToJSON a, FromJSON a) => SubredditName -> a -> m a+addNormalWidget sname x =+    runAction defaultAPIAction+              { pathSegments = subAPIPath sname "widget"+              , method       = POST+              , requestData  = mkTextFormData [ ("json", textEncode x) ]+              }++addDescribableWidget+    :: (MonadReddit m, ToJSON a, FromJSON a)+    => Maybe Body+    -> SubredditName+    -> a+    -> m a+addDescribableWidget desc sname x =+    runAction defaultAPIAction+              { pathSegments = subAPIPath sname "widget"+              , method       = POST+              , requestData  =+                    mkTextFormData [ ( "json"+                                     , textEncode . describeWidget x+                                       $ fromMaybe mempty desc+                                     )+                                   ]+              }++-- Certain 'Widget's can be given markdown-formatted description field. This+-- function injects the field into the widget\'s JSON 'Object' if applicable,+-- otherwise returning the value as-is+describeWidget :: ToJSON a => a -> Body -> Value+describeWidget widget (String -> desc) = case toJSON widget of+    Object o -> Object $ HM.insert "description" desc o+    v        -> v++-- | Upload a widget image from a filepath. This returns the URL of the new image,+-- which is required for creating certain widgets+uploadWidgetImage :: MonadReddit m => SubredditName -> FilePath -> m UploadURL+uploadWidgetImage sname fp = do+    S3ModerationLease { action, key }+        <- uploadS3Image True (subAPIPath sname "widget_image_upload_s3") fp+    pure . wrappedFrom $ T.intercalate "/" [ action, key ]++uploadS3Image :: MonadReddit m+              => Bool+              -> [PathSegment]+              -> FilePath+              -> m S3ModerationLease+uploadS3Image rawJSON pathSegments fp = do+    mimetype <- case FP.takeExtension fp of+        ext+            | ext `elem` [ ".jpeg", ".jpg" ] -> pure "image/jpeg"+            | ext == ".png" -> pure "image/png"+            | otherwise ->+                throwM $ InvalidRequest "uploadS3Image: invalid file type"+    s3@S3ModerationLease { .. }+        <- runAction defaultAPIAction+                     { pathSegments+                     , method       = POST+                     , requestData  = mkTextFormData [ ( "filepath"+                                                       , toQueryParam+                                                         $ FP.takeFileName fp+                                                       )+                                                     , ("mimetype", mimetype)+                                                     ]+                     }+    (url, ps) <- splitURL action+    void . runActionWith_+        =<< mkRequest url+                      defaultAPIAction+                      { pathSegments = ps+                      , method       = POST+                      , requestData  = WithMultipart+                            $ HM.foldrWithKey mkParts+                                              [ partFile "file" fp ]+                                              fields+                      , rawJSON+                      }+    pure s3+  where+    mkParts name value ps = partBS name (T.encodeUtf8 value) : ps++--Emoji------------------------------------------------------------------------+-- | Add a new emoji by uploading an image. See 'mkEmoji' to conveniently create+-- new 'Emoji's to add. Also note the restrictions on the filepath argument below,+-- which are not currently validated by this action. This action can also be used+-- to update the image for an existing emoji (see+-- 'Network.Reddit.Actions.Subreddit.getSubredditEmoji') to get a list of emojis+-- for a subreddit+addEmoji :: MonadReddit m+         => SubredditName+         -> FilePath+         -- ^ Must be an image in jpeg/png format, with maximum dimensions of+         -- 128 x 128px and size of 64KB+         -> Emoji+         -> m ()+addEmoji sname fp emoji = do+    S3ModerationLease { key }+        <- uploadS3Image False (v1Path sname "emoji_asset_upload_s3.json") fp+    runAction_ defaultAPIAction+               { pathSegments = v1Path sname "emoji.json"+               , method       = POST+               , requestData  = WithForm+                     $ toForm @NewEmoji (wrappedFrom emoji)+                     <> mkTextForm [ ("s3_key", toQueryParam key) ]+               }++-- | Delete a single emoji and associated s3 image+deleteEmoji :: MonadReddit m => SubredditName -> EmojiName -> m ()+deleteEmoji sname ename =+    runAction_ defaultAPIAction+               { pathSegments = v1Path sname "emoji" <> [ toUrlPiece ename ]+               , method       = DELETE+               }++-- | Update an emoji. Only the boolean permissions fields will be sent. If you+-- would like to change the image associated with the emoji name, use 'addEmoji'+-- with an updated filepath+updateEmoji :: MonadReddit m => SubredditName -> Emoji -> m ()+updateEmoji sname emoji =+    runAction_ defaultAPIAction+               { pathSegments = v1Path sname "emoji_permissions"+               , method       = POST+               , requestData  = WithForm $ toForm emoji+               }++-- | Set the (h, w) dimensions for /all/ custom emojis on the subreddit. Both+-- dimensions must be between 16px and 40px. A @Nothing@ argument will disable+-- custom sizes+setCustomEmojiSize+    :: MonadReddit m => SubredditName -> Maybe (Int, Int) -> m ()+setCustomEmojiSize sname = \case+    Nothing        -> runAction_ r { requestData = WithForm mempty }+    Just ss@(h, w) -> case bimap inR inR ss of+        (True, True) ->+            runAction_ r+                       { requestData =+                             mkTextFormData [ ("height", toQueryParam h)+                                            , ("width", toQueryParam w)+                                            ]+                       }+        _            -> throwM . InvalidRequest+            $ "setCustomEmojiSize: Height and width must be between 16px and 40px"+  where+    inR = inRange (16, 40)++    r   = defaultAPIAction+        { pathSegments = v1Path sname "emoji_custom_size", method = POST }++v1Path :: ToHttpApiData a => a -> PathSegment -> [PathSegment]+v1Path sname path = [ "api", "v1", toUrlPiece sname ] <> [ path ]++--Misc-------------------------------------------------------------------------+-- | Get traffic statistics for the given subreddit+getTraffic :: MonadReddit m => SubredditName -> m Traffic+getTraffic sname =+    runAction defaultAPIAction { pathSegments = subAboutPath sname "traffic" }
+ src/Network/Reddit/Multireddit.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}++-- |+-- Module      : Network.Reddit.Multireddit+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions for 'Multireddit's composed of several 'Subreddit's+--+module Network.Reddit.Multireddit+    (  -- * Actions+      getMultireddit+    , addToMultireddit+    , removeFromMultireddit+    , deleteMultireddit+    , copyMultireddit+    , createMultireddit+    , updateMultireddit+      -- ** Filters+      -- | These filters only work on the special subreddits \"all\" and+      -- \"mod\". When a filter subreddit is added, it will no longer appear+      -- in @Listing@s for the special subreddit. All of the actions will+      -- throw 'ErrorWithStatus' exceptions if a non-special subreddit is+      -- provided as the first argument. Filters are provided as types of+      -- 'Multireddit's+    , listFilters+    , addFilter+    , removeFilter+    , clearFilters+      -- * Types+    , module M+    ) where++import           Data.Aeson                       ( KeyValue((.=)) )+import           Data.Foldable                    ( traverse_ )++import           Network.Reddit.Internal+import           Network.Reddit.Me+import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Multireddit+import           Network.Reddit.Types.Multireddit as M+                 ( MultiName+                 , MultiPath(MultiPath)+                 , MultiUpdate+                 , MultiVisibility(..)+                 , Multireddit(Multireddit)+                 , NewMulti+                 , NewMultiF(NewMultiF)+                 , defaultMultiUpdate+                 , mkMultiName+                 , multiUpdate+                 )+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Utils++import           Web.HttpApiData                  ( ToHttpApiData(..) )++-- | Get a 'Multireddit' by its path+getMultireddit :: MonadReddit m => MultiPath -> m Multireddit+getMultireddit mpath =+    runAction defaultAPIAction+              { pathSegments = [ "api", "multi", toUrlPiece mpath ] }++-- | Add the given subreddit to the existing multireddit+addToMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m ()+addToMultireddit mpath sname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api"+                                , "multi"+                                , toUrlPiece mpath+                                , "r"+                                , toUrlPiece sname+                                ]+               , method       = PUT+               , requestData  =+                     mkTextFormData [ ( "model"+                                      , textObject [ "name" .= sname ]+                                      )+                                    ]+               }++-- | Remove a single subreddit from the existing multireddit+removeFromMultireddit :: MonadReddit m => MultiPath -> SubredditName -> m ()+removeFromMultireddit mpath sname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api"+                                , "multi"+                                , toUrlPiece mpath+                                , "r"+                                , toUrlPiece sname+                                ]+               , method       = DELETE+               }++-- | Delete an existing multireddit+deleteMultireddit :: MonadReddit m => MultiPath -> m ()+deleteMultireddit mpath =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "multi", toUrlPiece mpath ]+               , method       = DELETE+               }++-- | Copy an existing 'Multireddit', returning the new one+copyMultireddit :: MonadReddit m => MultiPath -> MultiName -> m Multireddit+copyMultireddit mpath mname = do+    -- For some reason, Reddit does not automatically generate the correct path+    -- for the destination multireddit, but instead requires sending the path in+    -- the request body. This requires manually fetching the username of the+    -- authenticated user, to construct the correct destination multipath+    Account { username } <- getMe+    runAction defaultAPIAction+              { pathSegments = [ "api", "multi", "copy" ]+              , method       = POST+              , requestData  =+                    mkTextFormData [ ( "to"+                                     , toQueryParam $ MultiPath username mname+                                     )+                                   , ("from", toQueryParam mpath)+                                   , ("display_name", toQueryParam mname)+                                   ]+              }++-- | Create a new 'Multireddit'. Will throw a 409 'ErrorWithStatus' if the+-- proposed multireddit already exists. The new multireddit will be created at+-- the provided 'MultiPath' parameter+createMultireddit :: MonadReddit m => NewMulti -> MultiPath -> m Multireddit+createMultireddit newm mpath =+    runAction defaultAPIAction+              { pathSegments = [ "api", "multi", toUrlPiece mpath ]+              , method       = POST+              , requestData  = mkTextFormData [ ("model", textEncode newm) ]+              }++-- | Update an existings multireddit, returning the same 'Multireddit' with the+-- updates applied+updateMultireddit+    :: MonadReddit m => MultiUpdate -> MultiPath -> m Multireddit+updateMultireddit mupd mpath =+    runAction defaultAPIAction+              { pathSegments = [ "api", "multi", toUrlPiece mpath ]+              , method       = PUT+              , requestData  = mkTextFormData [ ("model", textEncode mupd) ]+              }++-- | List all of the filters configured for the special subreddit. If no filters+-- have been applied, this will throw an 'ErrorWithStatus' exception+listFilters :: MonadReddit m => SubredditName -> m Multireddit+listFilters special = do+    Account { username } <- getMe+    runAction defaultAPIAction { pathSegments = filterPath username special }++-- | Add a subreddit to filter from the special subreddit+addFilter :: MonadReddit m+          => SubredditName -- ^ The special sub+          -> SubredditName -- ^ The sub to filter+          -> m ()+addFilter special sname = do+    Account { username } <- getMe+    runAction_ defaultAPIAction+               { pathSegments =+                     filterPath username special <> [ "r", toUrlPiece sname ]+               , method       = PUT+               , requestData  =+                     mkTextFormData [ ( "model"+                                      , textObject [ "name" .= sname ]+                                      )+                                    ]+               }++-- | Remove a filtered subreddit from the special subreddit. This action will+-- succeed even if the filtered subreddit is not in the special subreddit filter+removeFilter :: MonadReddit m+             => SubredditName -- ^ The special sub+             -> SubredditName -- ^ The sub to remove from the filter+             -> m ()+removeFilter special sname = do+    Account { username } <- getMe+    runAction_ defaultAPIAction+               { pathSegments =+                     filterPath username special <> [ "r", toUrlPiece sname ]+               , method       = DELETE+               }++-- | Remove all of the filters for the special subreddit+clearFilters :: MonadReddit m => SubredditName -> m ()+clearFilters special = do+    Multireddit { subreddits } <- listFilters special+    traverse_ (removeFilter special) subreddits++filterPath :: Username -> SubredditName -> [PathSegment]+filterPath uname sname =+    [ "api", "filter", "user", toUrlPiece uname, "f", toUrlPiece sname ]
+ src/Network/Reddit/Submission.hs view
@@ -0,0 +1,576 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      : Network.Reddit.Submission+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Submission+    (  -- * Reading submissions+      getSubmissions+    , getSubmission+    , getSubmissionByURL+    , getSubmissionsByDomain+    , getBest+    , getChildComments+    , getDuplicateSubmissions+    , saveSubmission+    , unsaveSubmission+    , hideSubmissions+    , hideSubmission+    , unhideSubmissions+    , unhideSubmission+      -- * Creating, editing, and deleting+    , deleteSubmission+    , editSubmission+    , replyToSubmission+    , submitSelfPost+    , submitWithInlineMedia+    , submitLink+    , submitImage+    , submitVideo+    , submitPoll+    , submitGallery+    , submit+    , crosspost+    , setSubmissionReplies+      -- * Submission flair+    , getSubmissionFlairChoices+    , selectSubmissionFlair+      -- * Searching+    , search+      -- * Voting+      -- $vote+    , upvoteSubmission+    , downvoteSubmission+    , unvoteSubmission+    , reportSubmission+      -- * Misc+    , unmarkNSFW+    , markNSFW+    , setOC+    , unsetOC+    , setSpoiler+    , unsetSpoiler+      -- * Types+    , module M'+    ) where++import           Control.Monad                         ( void, when )+import           Control.Monad.Catch                   ( MonadThrow(throwM) )+import           Control.Monad.IO.Class                ( MonadIO(liftIO) )++import           Data.Aeson                            ( ToJSON(toJSON) )+import           Data.Generics.Product                 ( HasField(field) )+import           Data.Generics.Wrapped+                 ( wrappedFrom+                 , wrappedTo+                 )+import qualified Data.HashMap.Strict                   as HM+import qualified Data.Map                              as M+import           Data.Maybe                            ( fromMaybe )+import           Data.Sequence                         ( Seq((:<|), Empty) )+import           Data.Text                             ( Text )+import qualified Data.Text                             as T+import qualified Data.Text.Encoding                    as T+import           Data.Traversable                      ( for )++import           Lens.Micro++import           Network.HTTP.Client.MultipartFormData ( partBS, partFile )+import           Network.Reddit.Internal+import           Network.Reddit.Item+import           Network.Reddit.Subreddit+import           Network.Reddit.Types+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Submission       as M'+                 ( Collection(Collection)+                 , CollectionID+                 , CollectionLayout(..)+                 , CrosspostOptions(CrosspostOptions)+                 , Fancypants+                 , GalleryImage(GalleryImage)+                 , InlineMedia(InlineMedia)+                 , InlineMediaType(..)+                 , NewCollection(NewCollection)+                 , NewSubmission(..)+                 , Poll(Poll)+                 , PollData(PollData)+                 , PollOption(PollOption)+                 , PollOptionID+                 , PostedSubmission+                 , ResultID(ResultID)+                 , S3UploadLease(S3UploadLease)+                 , Search(Search)+                 , SearchCategory+                 , SearchOpts(SearchOpts)+                 , SearchSort(..)+                 , SearchSyntax(..)+                 , Submission(Submission)+                 , SubmissionContent(..)+                 , SubmissionID(SubmissionID)+                 , SubmissionOptions(SubmissionOptions)+                 , mkCrosspostOptions+                 , mkGalleryImage+                 , mkPoll+                 , mkSearch+                 , mkSearchCategory+                 , mkSubmissionOptions+                 , writeInlineMedia+                 )+import           Network.Reddit.Utils++import           Paths_heddit++import qualified System.FilePath                       as FP++import           Web.FormUrlEncoded                    ( ToForm(toForm) )+import           Web.HttpApiData                       ( ToHttpApiData(..) )+import           Web.Internal.FormUrlEncoded           ( Form )++-- | Get a information on 'Submission's given a container of 'SubmissionID's+getSubmissions :: (MonadReddit m, Foldable t)+               => ItemOpts Submission+               -> t SubmissionID+               -> m (Seq Submission)+getSubmissions = getMany++-- | Get information on a single submission. Throws an exception if no such+-- 'Submission' exists+getSubmission :: MonadReddit m => SubmissionID -> m Submission+getSubmission sid = getSubmissions defaultItemOpts [ sid ] >>= \case+    sub :<| _ -> pure sub+    _         -> throwM $ InvalidResponse "getSubmission: No results"++-- | Get a 'Submission' from a URL pointing to it, in one of the following forms:+--+--      * http{s}:\/\/redd.it\/\<ID\>+--      * http{s}:\/\/{www.}reddit.com\/comments\/\<ID\>\/+--      * http{s}:\/\/{www.}reddit.com\/r\/\<SUBREDDIT\>\/comments\/\<ID\>\/{NAME}+--      * http{s}:\/\/{www.}reddit.com\/gallery\/\<ID\>+--+getSubmissionByURL :: MonadReddit m => URL -> m Submission+getSubmissionByURL url = getSubmission =<< submissionIDFromURL url++-- | Get a @Listing@ of submissions based on their domain+getSubmissionsByDomain :: MonadReddit m+                       => Domain+                       -> Paginator SubmissionID Submission+                       -> m (Listing SubmissionID Submission)+getSubmissionsByDomain dm paginator =+    runAction defaultAPIAction+              { pathSegments = [ "domain", dm ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get the \"best\" 'Submission's from the frontpage+getBest :: MonadReddit m+        => Paginator SubmissionID Submission+        -> m (Listing SubmissionID Submission)+getBest paginator = runAction defaultAPIAction+                              { pathSegments = [ "best" ]+                              , requestData  = paginatorToFormData paginator+                              }++-- | Get a submission\'s 'ChildComment's+getChildComments :: MonadReddit m => SubmissionID -> m (Seq ChildComment)+getChildComments sid = runAction @WithChildren r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = [ "comments", toUrlPiece sid ] }++-- | Get a @Listing@ of 'Submission's that are marked as duplicates of the given+-- submission+getDuplicateSubmissions :: MonadReddit m => SubmissionID -> m (Seq Submission)+getDuplicateSubmissions sid =+    -- This endpoint is very strange. It returns an /array/ of @Listing@s, each of+    -- which contains a single submission in its @children@ field. Having tested it,+    -- it appears that the @after@ field is always @null@. Not sure if this is the+    -- correct way to deal with this, but getting a @Seq@ of subsmissions is a lot+    -- more ergonomic than a nested mess of @Listing@s+    runAction @[Listing SubmissionID Submission] r >>= \case+        []   -> pure Empty+        dups -> pure . mconcat $ dups <&> (^. field @"children")+  where+    r = defaultAPIAction { pathSegments = [ "duplicates", toUrlPiece sid ] }++-- | Save a submission+saveSubmission :: MonadReddit m => SubmissionID -> m ()+saveSubmission = save . SubmissionItemID++-- | Unsave a submission+unsaveSubmission :: MonadReddit m => SubmissionID -> m ()+unsaveSubmission = unsave . SubmissionItemID++-- | Hide the submissions corresponding to a container of 'SubmissionID's. The+-- submissions will no longer appear in your default view of submissions on the+-- subdreddit+hideSubmissions :: (MonadReddit m, Foldable t) => t SubmissionID -> m ()+hideSubmissions = hide "hide"++-- | Hide a single submission+hideSubmission :: MonadReddit m => SubmissionID -> m ()+hideSubmission sid = hideSubmissions [ sid ]++-- | Unhide the submissions corresponding to a container of 'SubmissionID's,+-- returning them to your default view+unhideSubmissions :: (MonadReddit m, Foldable t) => t SubmissionID -> m ()+unhideSubmissions = hide "unhide"++-- | Unhide a single submission+unhideSubmission :: MonadReddit m => SubmissionID -> m ()+unhideSubmission sid = unhideSubmissions [ sid ]++hide :: (MonadReddit m, Foldable t) => Text -> t SubmissionID -> m ()+hide path ss =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", path ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname ss) ]+               }++-- | Delete a submission that the currently authenticated user has authored+deleteSubmission :: MonadReddit m => SubmissionID -> m ()+deleteSubmission = delete . SubmissionItemID++-- | Edit a submission, receving an updated 'Submission' in response+editSubmission :: MonadReddit m => SubmissionID -> Body -> m Submission+editSubmission (SubmissionItemID -> sid) txt = edit sid txt >>= \case+    SubmissionItem s -> pure s+    CommentItem _    -> throwM+        $ InvalidResponse "editSubmission: Expected a Submission, got a Comment"++-- | Leave a reply on a submission, returning the new 'Comment' that has been+-- created+replyToSubmission :: MonadReddit m => SubmissionID -> Body -> m Comment+replyToSubmission = reply . SubmissionItemID++-- | Submit a new self-post (with no inline media)+submitSelfPost+    :: MonadReddit m => SubredditName -> Title -> Body -> m Submission+submitSelfPost sname t b = submit $ SelfPost b (mkSubmissionOptions sname t)++-- | Submit a new self-post with inline media. The @Body@ must be markdown-+-- formatted text containing placeholders. Each placeholder must correspond to+-- exactly one of the 'InlineMedia's\' @key@ field. For example, given the+-- following:+--+-- >>> gif = InlineMedia InlineGIF "/path/to/a.gif" "gif" Nothing+-- >>> vid = InlineMedia InlineVideo "/path/to/a.mp4" "vid" (Just "my video")+-- >>> body = "Body with an inline gif #gif# and video #vid#"+-- >>> submitWithInlineMedia Nothing body [gif, vid] myOptions+--+-- Will automatically produce (internally) the following markdown body for+-- the submission, after uploading the media to Reddit\'s servers:+--+-- @+--    Body with an inline gif+--+--    ![gif](j2k2xmfl3 \"\")+--+--     and video+--+--    ![video](ccdoe02xu \"my video\")+-- @+--+submitWithInlineMedia+    :: (MonadReddit m, Traversable t)+    => Maybe Char+    -- ^ Delimiter for the placeholders in the body, defaults to @#@+    -> Body -- ^ Should contain the placeholders, as described above+    -> t InlineMedia+    -- ^ The @key@ field in each 'InlineMedia' must correspond to+    -- exactly one of the placeholders in the body+    -> SubmissionOptions+    -> m Submission+submitWithInlineMedia (T.singleton . fromMaybe '#' -> delim) b media sos = do+    uploaded <- for media $ \m@InlineMedia { mediaPath } ->+        inlineMediaToUpload m <$> uploadMedia SelfPostUpload mediaPath+    rtjson <- putOnTheFancypants $ foldr replacePlaceholders b uploaded+    getSubmissionByURL . wrappedTo+        =<< runAction @PostedSubmission+                      (submissionAction . toForm $ WithInlineMedia rtjson sos)+  where+    replacePlaceholders im@InlineMediaUpload { .. } md =+        T.replace (delim <> key <> delim) (writeInlineMedia im) md++putOnTheFancypants :: MonadReddit m => Body -> m Fancypants+putOnTheFancypants b =+    runAction defaultAPIAction+              { pathSegments = [ "api", "convert_rte_body_format" ]+              , method       = POST+              , requestData  = mkTextFormData [ ("output_mode", "rtjson")+                                              , ("markdown_text", b)+                                              ]+              }++-- | Submit a new link post+submitLink :: MonadReddit m => SubredditName -> Title -> URL -> m Submission+submitLink sname t u = submit $ Link u (mkSubmissionOptions sname t)++-- | Post an image submission to the subreddit, uploading the image file. This+-- action does not currently return the posted submission upon success+submitImage :: MonadReddit m+            => FilePath -- ^ Must be a valid image file+            -> SubmissionOptions+            -> m ()+submitImage fp sos = do+    url <- uploadMedia LinkUpload fp+    runAction_ . submissionAction . toForm $ ImagePost url sos++-- | Post an image submission to the subreddit, uploading the image file. This+-- action does not currently return the posted submission upon success+submitVideo :: MonadReddit m+            => Bool -- ^ If @True@, creates a silent \"videogif\"+            -> FilePath -- ^ Must be a valid video file+            -> Maybe FilePath+            -- ^ Must be a valid image file, for the video thumbnail. If+            -- @Nothing@, a PNG of the Haskell logo will be used+            -> SubmissionOptions+            -> m ()+submitVideo videogif fp thmbFP sos = do+    url <- uploadMedia LinkUpload fp+    thmbURL <- uploadMedia LinkUpload =<< maybe defaultPNG pure thmbFP+    runAction_ . submissionAction . toForm+        $ VideoPost url thmbURL videogif sos+  where+    defaultPNG = liftIO $ getDataFileName "assets/haskell.png"++-- | Post a poll to the subreddit. See 'mkPoll' to create a new 'Poll'+submitPoll+    :: (MonadReddit m, Foldable t) => Poll t -> SubmissionOptions -> m ()+submitPoll poll sos =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "submit_poll_post.json" ]+               , method       = POST+               , requestData  = WithJSON . toJSON $ PollSubmission poll sos+               }++-- | Post a gallery to the subreddit, given a container of 'GalleryImage's. See+-- 'mkGalleryImage' to create the images with default values. This action also+-- ensures that the image container has at least two elements+submitGallery :: (MonadReddit m, Traversable t)+              => t GalleryImage+              -> SubmissionOptions+              -> m ()+submitGallery imgs sos = do+    when (length imgs < 2) . throwM+        $ InvalidRequest --+        "submitGallery: Galleries must consist of at least 2 images"+    gallery <- for imgs $ \img@GalleryImage { imagePath } ->+        galleryImageToUpload img <$> uploadMedia GalleryUpload imagePath+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "submit_gallery_post.json" ]+               , method       = POST+               , requestData  =+                     WithJSON . toJSON $ GallerySubmission gallery sos+               }++-- | Submit a new submission, returning the 'Submission' that has been created.+-- This action allows for more fine-grained control over submission options. You+-- can use 'mkSubmissionOptions' for defaults and update it as needed. See also+-- 'submitImage', 'submitPoll', and 'submitGallery', which should be used when+-- submitting anything beyond a self-text or link post+submit :: MonadReddit m => NewSubmission -> m Submission+submit (toForm -> n) = getSubmissionByURL . wrappedTo+    =<< runAction @PostedSubmission (submissionAction n)++-- | Crosspost an existing submission. You must be a subscriber of the subreddit+-- you are posting into. See also 'mkCrosspostOptions'+crosspost :: MonadReddit m => SubmissionID -> CrosspostOptions -> m Submission+crosspost sid cpos = getSubmission+    =<< (runAction @PostedCrosspost r <&> wrappedTo)+  where+    r = submissionAction+        $ toForm cpos <> mkTextForm [ ("crosspost_fullname", fullname sid) ]++submissionAction :: Form -> APIAction a+submissionAction form = defaultAPIAction+    { pathSegments = [ "api", "submit" ]+    , method       = POST+    , requestData  = WithForm form+    }++-- Calls an undocumented API endpoint to upload media to an s3 bucket. It returns+-- the URL of the uploaded media along with a a websocket URL that can be used+-- to detect the upload completion+uploadMedia :: MonadReddit m => UploadType -> FilePath -> m UploadURL+uploadMedia uty fp = do+    mimetype <- case FP.takeExtension fp of+        ext+            | Just mt <- M.lookup ext mimeMap -> pure mt+            | otherwise ->+                throwM $ InvalidRequest "uploadMedia: invalid media file type"++    S3UploadLease { .. }+        <- runAction defaultAPIAction+                     { pathSegments = [ "api", "media", "asset.json" ]+                     , method       = POST+                     , requestData  = mkTextFormData --+                           [ ("filepath", toQueryParam $ FP.takeFileName fp)+                           , ("mimetype", mimetype)+                           ]+                     }++    (url, ps) <- splitURL action+    void . runActionWith_+        =<< mkRequest url+                      defaultAPIAction+                      { pathSegments = ps+                      , method       = POST+                      , requestData  = WithMultipart+                            $ HM.foldrWithKey mkParts+                                              [ partFile "file" fp ]+                                              fields+                      , rawJSON      = False+                      }+    pure $ case uty of+        LinkUpload -> wrappedFrom $ T.intercalate "/" [ action, key ]+        _          -> assetID+  where+    mimeMap               =+        M.fromList [ (".png", "image/png")+                   , (".mov", "video/quicktime")+                   , (".mp4", "video/mp4")+                   , (".jpg", "image/jpeg")+                   , (".jpeg", "image/jpeg")+                   , (".gif", "image/gif")+                   ]++    mkParts name value ps = partBS name (T.encodeUtf8 value) : ps++-- | Enable/disable inbox replies for a submission+setSubmissionReplies :: MonadReddit m => Bool -> SubmissionID -> m ()+setSubmissionReplies p = setInboxReplies p . SubmissionItemID++-- | Select a 'FlairChoice' for a submission.+selectSubmissionFlair+    :: MonadReddit m => FlairSelection -> SubmissionID -> m ()+selectSubmissionFlair (FlairSelection FlairChoice { .. } _ sname) sid =+    runAction_ defaultAPIAction+               { pathSegments = subAPIPath sname "flairselector"+               , method       = POST+               , requestData  = WithForm+                     $ mkTextForm [ ("link", fullname sid)+                                  , ( "flair_template_id"+                                    , toQueryParam templateID+                                    )+                                  ]+               }++-- | 'Search' through Reddit 'Submission's, either side-wide or constrained to+-- one subreddit. See 'mkSearch' to create the initial 'Search'+search :: MonadReddit m+       => Search+       -> Paginator ResultID Submission+       -> m (Listing ResultID Submission)+search sch@Search { .. } paginator =+    runAction defaultAPIAction { pathSegments, requestData }+  where+    pathSegments = [ "search" ]+        & maybe id (\s -> (<>) [ "r", toUrlPiece s ]) subreddit++    requestData  = WithForm $ toForm paginator <> toForm sch++-- | Upvote a submission+upvoteSubmission :: MonadReddit m => SubmissionID -> m ()+upvoteSubmission = vote Upvote . SubmissionItemID++-- | Downvote a submission+downvoteSubmission :: MonadReddit m => SubmissionID -> m ()+downvoteSubmission = vote Downvote . SubmissionItemID++-- | Remove an existing vote on a submission+unvoteSubmission :: MonadReddit m => SubmissionID -> m ()+unvoteSubmission = vote Unvote . SubmissionItemID++-- | Report a submission to the subreddit\'s mods+reportSubmission :: MonadReddit m => Report -> SubmissionID -> m ()+reportSubmission r = report r . SubmissionItemID++-- | Mark a submission NSFW. The submission author can use this as well as the+-- subreddit moderators+markNSFW :: MonadReddit m => SubmissionID -> m ()+markNSFW sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "marknsfw" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname sid) ]+               }++-- | Unmark a submission NSFW. The submission author can use this as well as the+-- subreddit moderators+unmarkNSFW :: MonadReddit m => SubmissionID -> m ()+unmarkNSFW sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "unmarknsfw" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname sid) ]+               }++-- | Mark a submission as original content. In order for normal users to use+-- this feature in addition to mods, the beta \"Original Content\" feature must+-- be enabled in the subreddit settings+setOC :: MonadReddit m => SubredditName -> SubmissionID -> m ()+setOC = setUnsetOC True++-- | Unmark a submission as original content. In order for normal users to use+-- this feature in addition to mods, the beta \"Original Content\" feature must+-- be enabled in the subreddit settings+unsetOC :: MonadReddit m => SubredditName -> SubmissionID -> m ()+unsetOC = setUnsetOC False++setUnsetOC :: MonadReddit m => Bool -> SubredditName -> SubmissionID -> m ()+setUnsetOC shouldSet sname sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "set_original_content" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("id", toQueryParam sid)+                                    , ("fullname", fullname sid)+                                    , ( "should_set_oc"+                                      , toQueryParam shouldSet+                                      )+                                    , ("execute", toQueryParam False)+                                    , ("r", toQueryParam sname)+                                    ]+               }++-- | Mark the submission as containing spoilers+setSpoiler :: MonadReddit m => SubmissionID -> m ()+setSpoiler sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "spoiler" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname sid) ]+               }++-- | Unmark the submission as containing spoilers+unsetSpoiler :: MonadReddit m => SubmissionID -> m ()+unsetSpoiler sid =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "unspoiler" ]+               , method       = POST+               , requestData  = mkTextFormData [ ("id", fullname sid) ]+               }+--+-- $vote+-- __Note__: According to Reddit\'s API rules:+--+-- votes must be cast by humans. That is, API clients proxying a human's+-- action one-for-one are OK, but bots deciding how to vote on content or amplifying+-- a human's vote are not. See the reddit rules for more details on what constitutes+-- vote cheating.+--
+ src/Network/Reddit/Subreddit.hs view
@@ -0,0 +1,670 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Types.Subreddit+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Subreddit+    (  -- * Actions+      getSubreddit+    , getSubredditRules+    , getPostRequirements+    , getHotSubmissions+    , getNewSubmissions+    , getRandomRisingSubmissions+    , getControversialSubmissions+    , getRisingSubmissions+    , getTopSubmissions+    , getRandomSubmission+    , getStickiedSubmission+    , subscribe+    , unsubscribe+    , quarantineOptIn+    , quarantineOptOut+      -- * Subreddit @Listing@s+      -- | These actions return @Listing@s of subreddits site-wide+      -- corresponding to various filters+    , getDefaultSubreddits+    , getNewSubreddits+    , getPopularSubreddits+    , getPremiumSubreddits+    , getGoldSubreddits+    , searchSubreddits+    , searchSubredditsByName+    , getRecommendedSubreddits+    , followCollection+    , unfollowCollection+      -- * Collections+    , getCollections+    , getCollectionsWithName+    , getCollection+    , getCollectionByPermalink+      -- * Flair+    , getUserFlairTemplates+    , getSubmissionFlairTemplates+    , getNewSubmissionFlairChoices+    , getUserFlairChoices+    , getSubmissionFlairChoices+      -- * Wiki+    , getWikiPage+    , getWikiPages+    , getWikiPageRevision+    , getWikiPageRevisions+    , editWikiPage+    , createWikiPage+      -- * Widgets+    , getSubredditWidgets+    , getAllSubredditWidgets+      -- * Emojis+    , getSubredditEmojis+      -- * Types+    , module M+    ) where++import           Control.Monad.Catch             ( MonadCatch(catch)+                                                 , MonadThrow(throwM)+                                                 )++import           Data.Aeson                      ( FromJSON )+import           Data.ByteString                 ( ByteString )+import           Data.Generics.Wrapped           ( wrappedTo )+import           Data.Maybe                      ( fromMaybe )+import           Data.Sequence                   ( Seq((:<|)) )+import           Data.Text                       ( Text )+import qualified Data.Text.Encoding              as T++import           Lens.Micro                      ( (&), (<&>) )++import qualified Network.HTTP.Client.Conduit     as H+import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Emoji+import           Network.Reddit.Types.Emoji      as M+                 ( Emoji(Emoji)+                 , EmojiName+                 , mkEmoji+                 , mkEmojiName+                 )+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Flair      as M+                 ( AssignedFlair(AssignedFlair)+                 , CSSClass+                 , CurrentUserFlair+                 , FlairChoice(FlairChoice)+                 , FlairChoiceList+                 , FlairContent(..)+                 , FlairID+                 , FlairList(FlairList)+                 , FlairResult(FlairResult)+                 , FlairSelection(FlairSelection)+                 , FlairTemplate(FlairTemplate)+                 , FlairText+                 , FlairType(..)+                 , ForegroundColor(..)+                 , PostedFlairTemplate+                 , UserFlair(UserFlair)+                 , defaultFlairTemplate+                 , flairlistToListing+                 , mkFlairText+                 )+import           Network.Reddit.Types.Item+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Types.Subreddit  as M+                 ( BodyRestriction(..)+                 , NewSubredditRule(NewSubredditRule)+                 , PostRequirements(PostRequirements)+                 , PostedSubredditRule+                 , RuleType(..)+                 , Subreddit(Subreddit)+                 , SubredditID(SubredditID)+                 , SubredditName+                 , SubredditRule(SubredditRule)+                 , mkSubredditName+                 )+import           Network.Reddit.Types.Widget+import           Network.Reddit.Types.Widget     as M+                 ( Button(..)+                 , ButtonHover(..)+                 , ButtonImage(ButtonImage)+                 , ButtonText(ButtonText)+                 , ButtonWidget(ButtonWidget)+                 , CalendarConfig(CalendarConfig)+                 , CalendarWidget(CalendarWidget)+                 , CommunityInfo(CommunityInfo)+                 , CommunityListWidget(CommunityListWidget)+                 , CustomWidget(CustomWidget)+                 , IDCardWidget(IDCardWidget)+                 , Image(Image)+                 , ImageData(ImageData)+                 , ImageHover(ImageHover)+                 , ImageWidget(ImageWidget)+                 , MenuChild(..)+                 , MenuLink(MenuLink)+                 , MenuWidget(MenuWidget)+                 , ModInfo(ModInfo)+                 , ModeratorsWidget(ModeratorsWidget)+                 , PostFlairInfo(PostFlairInfo)+                 , PostFlairWidget(PostFlairWidget)+                 , PostFlairWidgetDisplay(..)+                 , RulesDisplay(..)+                 , RulesWidget(RulesWidget)+                 , ShortName+                 , Submenu(Submenu)+                 , SubredditWidgets(SubredditWidgets)+                 , TextAreaWidget(TextAreaWidget)+                 , TextHover(TextHover)+                 , Widget(..)+                 , WidgetID(WidgetID)+                 , WidgetSection(..)+                 , WidgetStyles(WidgetStyles)+                 , defaultCalendarConfig+                 , mkCommunityInfo+                 , mkPostFlairWidget+                 , mkShortName+                 , mkTextAreaWidget+                 )+import           Network.Reddit.Types.Wiki       as M+                 ( WikiPage(WikiPage)+                 , WikiPageListing+                 , WikiPageName+                 , WikiPageSettings(WikiPageSettings)+                 , WikiPermLevel(..)+                 , WikiRevision(WikiRevision)+                 , WikiRevisionID+                 , mkWikiPageName+                 )+import           Network.Reddit.Utils++import           Web.FormUrlEncoded              ( Form )+import           Web.HttpApiData                 ( ToHttpApiData(..) )+import           Web.Internal.FormUrlEncoded     ( ToForm(toForm) )++-- | Get information about a 'Subreddit'. An 'ErrorWithStatus' will be thrown if+-- attempting to query information on banned or private 'Subreddit's+getSubreddit :: MonadReddit m => SubredditName -> m Subreddit+getSubreddit sname = catchEmptyListing+    $ runAction defaultAPIAction+                { pathSegments = [ "r", toUrlPiece sname, "about" ] }++-- | Get a 'Subreddit'\'s 'SubredditRule's+getSubredditRules :: MonadReddit m => SubredditName -> m (Seq SubredditRule)+getSubredditRules sname = runAction @RuleList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "r", toUrlPiece sname, "about", "rules" ] }++-- | Get the requirements that moderators have configured for all submissions on+-- the given subreddit+getPostRequirements :: MonadReddit m => SubredditName -> m PostRequirements+getPostRequirements sname =+    runAction defaultAPIAction+              { pathSegments =+                    [ "api", "v1", toUrlPiece sname, "post_requirements" ]+              }++getHotSubmissions, getNewSubmissions, getRandomRisingSubmissions+    :: MonadReddit m+    => SubredditName+    -> Paginator SubmissionID Submission+    -> m (Listing SubmissionID Submission)++-- | Get \"hot\" 'Submission's for a given 'Subreddit'+getHotSubmissions = submissions "hot"++-- | Get \"new\" 'Submission's for a given 'Subreddit'+getNewSubmissions = submissions "new"++getControversialSubmissions, getRisingSubmissions, getTopSubmissions+    :: MonadReddit m+    => SubredditName+    -> Paginator SubmissionID Submission+    -> m (Listing SubmissionID Submission)++-- | Get \"controversial\" 'Submission's for a given 'Subreddit'+getControversialSubmissions = submissions "controversial"++-- | Get \"rising\" 'Submission's for a given 'Subreddit'+getRisingSubmissions = submissions "rising"++-- | Get \"top\" 'Submission's for a given 'Subreddit'+getTopSubmissions = submissions "top"++-- | Get \"rising\" 'Submission's for a given 'Subreddit'+getRandomRisingSubmissions = submissions "randomrising"++submissions :: (MonadReddit m, Thing a, FromJSON a)+            => Text+            -> SubredditName+            -> Paginator a Submission+            -> m (Listing a Submission)+submissions txt sname paginator =+    runAction defaultAPIAction+              { pathSegments = [ "r", toUrlPiece sname, txt ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get a random submission from the subreddit. The sub must support this feature,+-- or an 'ErrorWithStatus' exception will be thrown+getRandomSubmission :: MonadReddit m => SubredditName -> m Submission+getRandomSubmission sname =+    catchRedirected "getRandomSubmission" action handler+  where+    action     =+        runAction defaultAPIAction+                  { pathSegments    = [ "r", toUrlPiece sname, "random" ]+                  , followRedirects = False+                  }++    handler ps =+        runAction @[Listing ItemID Item]+                  defaultAPIAction+                  { pathSegments = T.decodeUtf8 <$> ps, needsAuth = False }++-- | Get one of the stickied submission, optionally specifying its position in the+-- sticky list, returning the top one otherwise. Note that this will throw an+-- 'ErrorWithStatus' if the sub does not have any stickied submissions+getStickiedSubmission+    :: MonadReddit m+    => Maybe Word+    -- ^ Which sticky to fetch. 1 is at the top of the sticky list, and is+    -- the default if this param is @Nothing@+    -> SubredditName+    -> m Submission+getStickiedSubmission num sname =+    catchRedirected "getStickiedSubmission" action handler+  where+    action     =+        runAction defaultAPIAction+                  { pathSegments    = subAboutPath sname "sticky"+                  , followRedirects = False+                  , requestData     =+                        mkTextFormData [ ( "num"+                                         , toQueryParam $ fromMaybe 1 num+                                         )+                                       ]+                  }++    handler ps =+        runAction @[Listing ItemID Item]+                  defaultAPIAction+                  { pathSegments = T.decodeUtf8 <$> ps, needsAuth = False }++-- HACK+-- This is a mega-hack to deal with how Reddit deals with the absence or+-- presence of certain subreddit features, like random and stickied+-- submissions+catchRedirected :: MonadCatch m+                => Text+                -> m Submission+                -> ([ByteString] -> m [Listing t Item])+                -> m Submission+catchRedirected func action handler = catch @_ @APIException action $ \case+    Redirected (Just req) -> case req & H.path & splitPath of+        [ r@"r", sub, c@"comments", path, t, j@".json" ] ->+            handler [ r, sub, c, path, t, j ] >>= \case+                Listing { children } : _ -> handleChildren children+                _ -> noResults+        _ -> throwM . InvalidResponse+            $ func <> ": Could not parse redirect URL"+    e -> throwM e+  where+    noResults      = throwM . InvalidResponse $ func <> ": No results"++    handleChildren = \case+        SubmissionItem s :<| _ -> pure s+        _ -> noResults++-- | Subscribe to a single subreddit+subscribe :: MonadReddit m => SubredditName -> m ()+subscribe sname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "subscribe" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("sr_name", toQueryParam sname)+                                    , ("action", "sub")+                                    , ( "skip_initial_defaults"+                                      , toQueryParam True+                                      )+                                    ]+               }++-- | Unsubscribe from a single subreddit+unsubscribe :: MonadReddit m => SubredditName -> m ()+unsubscribe sname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", "subscribe" ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("sr_name", toQueryParam sname)+                                    , ("action", "unsub")+                                    ]+               }++-- | Allow the authenticated user to access the quarantined subreddit+quarantineOptIn :: MonadReddit m => SubredditName -> m ()+quarantineOptIn = quarantineOpt "quarantine_opt_in"++-- | Disallow the authenticated user from accessing the quarantined subreddit+quarantineOptOut :: MonadReddit m => SubredditName -> m ()+quarantineOptOut = quarantineOpt "quarantine_opt_out"++quarantineOpt :: MonadReddit m => PathSegment -> SubredditName -> m ()+quarantineOpt path sname =+    runAction_ defaultAPIAction+               { pathSegments = [ "api", path ]+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("sr_name", toQueryParam sname) ]+               }++getDefaultSubreddits, getNewSubreddits, getPopularSubreddits+    :: MonadReddit m+    => Paginator SubredditID Subreddit+    -> m (Listing SubredditID Subreddit)++-- | Get a @Listing@ of the default 'Subreddit's+getDefaultSubreddits = subredditListing "default"++-- | Get a @Listing@ of new 'Subreddit's site-wide+getNewSubreddits = subredditListing "new"++-- | Get a @Listing@ of popular 'Subreddit's site-wide+getPopularSubreddits = subredditListing "popular"++getPremiumSubreddits, getGoldSubreddits+    :: MonadReddit m+    => Paginator SubredditID Subreddit+    -> m (Listing SubredditID Subreddit)++-- | Get a @Listing@ of premium-only 'Subreddit's+getPremiumSubreddits = subredditListing "premium"++-- | Same as 'getPremiumSubreddits', provided for compatibility purposes+getGoldSubreddits = getPremiumSubreddits++-- | Search through subreddits based on both their names and descriptions+searchSubreddits :: MonadReddit m+                 => Text+                 -> Paginator SubredditID Subreddit+                 -> m (Listing SubredditID Subreddit)+searchSubreddits query paginator =+    runAction defaultAPIAction+              { pathSegments = [ "subreddits", "search" ]+              , requestData  =+                    WithForm $ toForm paginator <> mkTextForm [ ("q", query) ]+              }++-- | Search through subreddits based on both their names+searchSubredditsByName+    :: MonadReddit m+    => Maybe Bool+    -- ^ If NSWF subreddits should be included, defaulting to @True@ if @Nothing@+    -> Maybe Bool+    -- ^ Only exactly match the query, defaulting to @False@ if @Nothing@+    -> Text+    -> m (Seq SubredditName)+searchSubredditsByName withNSFW exact query =+    runAction @NameSearchResults r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "search_reddit_names" ]+        , method       = POST+        , requestData  =+              mkTextFormData [ ("query", query)+                             , ("exact", toQueryParam $ fromMaybe False exact)+                             , ( "include_over_18"+                               , toQueryParam $ fromMaybe True withNSFW+                               )+                             ]+        }++-- | Get a list of recommended subreddits based on the provided subs. Subreddits+-- to exclude from the recommendation may optionally be provided.+--+-- __Note__: Unfortunately, as of this writing, this action appears to only+-- return an empty array for all inputs+getRecommendedSubreddits+    :: (MonadReddit m, Foldable t)+    => Maybe (t SubredditName) -- ^ Subreddits to omit from the result+    -> t SubredditName -- ^ Subreddits to base the recommendations on+    -> m (Seq SubredditName)+getRecommendedSubreddits omit snames = runAction @RecsList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "recommend", "sr", joinParams snames ]+        , requestData  =+              mkTextFormData [ ("omit", maybe mempty joinParams omit) ]+        }++subredditListing :: MonadReddit m+                 => PathSegment+                 -> Paginator SubredditID Subreddit+                 -> m (Listing SubredditID Subreddit)+subredditListing path paginator =+    runAction defaultAPIAction+              { pathSegments = [ "subreddits", path ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get the 'Collection's of a subreddit, given the sub ID. Collections obtained+-- through this action will not have the @sortedLinks@ field+--+-- __Note__: if you don't know the ID of the subreddit, you can use+-- 'getNamedCollections', although this incurs an additional+-- network request to get the ID from the name+getCollections :: MonadReddit m => SubredditID -> m (Seq Collection)+getCollections sid =+    runAction defaultAPIAction+              { pathSegments = collectionsPath "subreddit_collections"+              , requestData  =+                    mkTextFormData [ ("sr_fullname", fullname sid) ]+              }++-- | Get the 'Collection's of a subreddit, given the name of the sub. Collections+-- obtained through this action will not have the @sortedLinks@ field+--+-- __Note__: this incurs a greater overhead than 'getCollections',+-- which you may want to use if you already know the @subredditID@+getCollectionsWithName :: MonadReddit m => SubredditName -> m (Seq Collection)+getCollectionsWithName sname = do+    Subreddit { subredditID } <- getSubreddit sname+    getCollections subredditID++-- | Fetch the specifig 'Collection', given its ID. This includes its @sortedLinks@+getCollection :: MonadReddit m => CollectionID -> m Collection+getCollection cid = catch @_ @APIException action $ \case+    -- An invalid UUID will cause Reddit to return an empty JSON array+    ErrorWithMessage EmptyError -> throwM . ErrorWithStatus+        $ StatusMessage 404 "getCollection: Collection does not exist"+    e -> throwM e+  where+    action =+        runAction defaultAPIAction+                  { pathSegments = collectionsPath "collection"+                  , requestData  = mkTextFormData [ ("collection_id", cid)+                                                  , ("include_links", "true")+                                                  ]+                  }++-- | Get a 'Collection' given its @permalink@. This includes its @sortedLinks@+--+-- Permalink URLs should be of the form+-- https:\/\/{www.}reddit.com\/r/\<SUBREDDIT\>\/collections\/\<ID\>+getCollectionByPermalink :: MonadReddit m => URL -> m Collection+getCollectionByPermalink pl = splitURL pl >>= \case+    (_, [ "r", _, "collection", cid ]) -> getCollection cid+    _ -> throwM+        $ InvalidRequest "getCollectionByPermalink: invalid permalink provided"++-- | Follow the collection for the authenticated user+followCollection :: MonadReddit m => CollectionID -> m ()+followCollection = followUnfollow True++-- | Unfollow the collection for the authenticated user+unfollowCollection :: MonadReddit m => CollectionID -> m ()+unfollowCollection = followUnfollow False++followUnfollow :: MonadReddit m => Bool -> CollectionID -> m ()+followUnfollow follow cid =+    runAction_ defaultAPIAction+               { pathSegments = collectionsPath "follow_collection"+               , method       = POST+               , requestData  =+                     mkTextFormData [ ("collection_id", cid)+                                    , ("follow", toQueryParam follow)+                                    ]+               }++collectionsPath :: PathSegment -> [PathSegment]+collectionsPath path = [ "api", "v1", "collections", path ]++-- | Get the user 'FlairTemplate's on the given subreddit. This will throw an+-- 'APIException' ('ErrorWithStatus') if the sub does not allow users to set+-- their own flair and the authenticated user does not have mod privileges on+-- the sub+getUserFlairTemplates+    :: MonadReddit m => SubredditName -> m (Seq FlairTemplate)+getUserFlairTemplates = v2Flair "user"++-- | Get the submission 'FlairTemplate's on the given subreddit+getSubmissionFlairTemplates+    :: MonadReddit m => SubredditName -> m (Seq FlairTemplate)+getSubmissionFlairTemplates = v2Flair "link"++v2Flair :: MonadReddit m => Text -> SubredditName -> m (Seq FlairTemplate)+v2Flair path sname =+    runAction defaultAPIAction+              { pathSegments = subAPIPath sname $ path <> "_flair_v2" }++-- | Get the available 'FlairChoice's for new submissions on the given subreddit+getNewSubmissionFlairChoices+    :: MonadReddit m => SubredditName -> m (Seq FlairChoice)+getNewSubmissionFlairChoices =+    flairChoices (mkTextForm [ ("is_newlink", toQueryParam True) ])++-- | Get the available 'FlairChoice's for a particular submission on the given+-- subreddit+getSubmissionFlairChoices+    :: MonadReddit m => SubredditName -> SubmissionID -> m (Seq FlairChoice)+getSubmissionFlairChoices sname sid = flairChoices form sname+  where+    form = mkTextForm [ ("link", fullname sid) ]++-- | Get the available 'FlairChoice's for new submissions on the current subreddit+getUserFlairChoices :: MonadReddit m => SubredditName -> m (Seq FlairChoice)+getUserFlairChoices = flairChoices (mkTextForm mempty)++flairChoices :: MonadReddit m => Form -> SubredditName -> m (Seq FlairChoice)+flairChoices form sname = runAction @FlairChoiceList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = subAPIPath sname "flairselector"+        , method       = POST+        , requestData  = WithForm form+        }++-- | Get the subreddit 'WikiPage' specified by name+getWikiPage :: MonadReddit m => SubredditName -> WikiPageName -> m WikiPage+getWikiPage sname wpage =+    runAction defaultAPIAction+              { pathSegments =+                    [ "r", toUrlPiece sname, "wiki", toUrlPiece wpage ]+              }++-- | Get all of the 'WikiPage's on the subreddit wiki+getWikiPages :: MonadReddit m => SubredditName -> m (Seq WikiPageName)+getWikiPages sname = runAction @WikiPageListing r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "r", toUrlPiece sname, "wiki", "pages" ] }++-- | Get a specific revision of a 'WikiPage', specified by name and 'WikiRevisionID'+getWikiPageRevision :: MonadReddit m+                    => SubredditName+                    -> WikiPageName+                    -> WikiRevisionID+                    -> m WikiPage+getWikiPageRevision sname wpage wr =+    runAction defaultAPIAction+              { pathSegments =+                    [ "r", toUrlPiece sname, "wiki", toUrlPiece wpage ]+              , requestData  = mkTextFormData [ ("v", toQueryParam wr) ]+              }++-- | Get a 'Listing' of the 'WikiRevision's for a given wikipage+getWikiPageRevisions+    :: MonadReddit m+    => SubredditName+    -> WikiPageName+    -> Paginator WikiRevisionID WikiRevision+    -> m (Listing WikiRevisionID WikiRevision)+getWikiPageRevisions sname wpage paginator =+    runAction defaultAPIAction+              { pathSegments = [ "r"+                               , toUrlPiece sname+                               , "wiki"+                               , "revisions"+                               , toUrlPiece wpage+                               ]+              , requestData  = paginatorToFormData paginator+              }++-- | Edit the given wikipage, replacing its contents with the new contents provided.+-- This requires moderator privileges or editing privileges for the page in question.+-- If the page corresponding to the given name does not exist, it will be created+editWikiPage :: MonadReddit m+             => SubredditName+             -> WikiPageName+             -> Maybe Text -- ^ The reason for the edit, if any+             -> Body -- ^ The new content for the page+             -> m ()+editWikiPage sname wpage r txt =+    runAction_ defaultAPIAction+               { pathSegments =+                     [ "r", toUrlPiece sname, "api", "wiki", "edit" ]+               , method       = POST+               , requestData  = mkTextFormData+                     $ [ ("page", toQueryParam wpage), ("content", txt) ]+                     <> foldMap pure (("reason", ) <$> r)+               }++-- | Create a new wikipage. If a page with the given name already exists, its+-- contents will be replaced+createWikiPage :: MonadReddit m+               => SubredditName+               -> WikiPageName+               -> Maybe Text -- ^ The reason for creating the page, if any+               -> Body -- ^ The new content for the page+               -> m ()+createWikiPage = editWikiPage++-- | Get a given subreddit\'s widgets+getSubredditWidgets :: MonadReddit m => SubredditName -> m SubredditWidgets+getSubredditWidgets sname = catchEmptyListing+    $ runAction defaultAPIAction { pathSegments = subAPIPath sname "widgets" }++-- | Get all of a subreddit\'s 'Widget's as a non-hierarchical list+getAllSubredditWidgets :: MonadReddit m => SubredditName -> m (Seq Widget)+getAllSubredditWidgets sname =+    catchEmptyListing $ runAction @WidgetList r <&> wrappedTo+  where+    r = defaultAPIAction { pathSegments = subAPIPath sname "widgets" }++-- | Get all of the emojis for the given subreddit. Note that this does not include+-- the builtin \"snoomojis\"+getSubredditEmojis :: MonadReddit m => SubredditName -> m (Seq Emoji)+getSubredditEmojis sname = runAction @EmojiList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "api", "v1", toUrlPiece sname, "emojis", "all" ] }
+ src/Network/Reddit/Types.hs view
@@ -0,0 +1,431 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Types+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types+    ( -- * Reddit+      RedditT+    , runRedditT+    , MonadReddit+    , UserAgent(..)+    , ClientSite+    , Client(..)+    , ClientState(..)+    , readClientState+    , WithData(..)+    , RateLimits(..)+    , readRateLimits+      -- * Auth+    , AppType(..)+    , AuthConfig(..)+    , AccessToken(..)+    , Token+    , Code+    , Scope(..)+    , PasswordFlow(..)+    , CodeFlow(..)+    , ClientID+    , ClientSecret+    , TokenDuration(..)+    , TokenManager(..)+      -- * Requests+    , APIAction(..)+    , Method(..)+    , PathSegment+      -- * Re-exports+    , module M+    ) where++import           Conduit                               ( MonadUnliftIO )++import           Control.Monad.Catch+                 ( MonadCatch+                 , MonadThrow+                 )+import           Control.Monad.Reader++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(parseJSON)+                 , Options(constructorTagModifier)+                 , Value(String)+                 , defaultOptions+                 , genericParseJSON+                 , withObject+                 , withText+                 )+import qualified Data.ByteString.Char8                 as C8+import           Data.Char                             ( toLower )+import           Data.Generics.Product                 ( HasField(field) )+import           Data.Text                             ( Text )+import qualified Data.Text                             as T+import           Data.Time+import           Data.Time.Clock.POSIX++import           GHC.Exts                              ( IsList(fromList) )+import           GHC.Generics                          ( Generic )++import           Lens.Micro++import           Network.HTTP.Client                   ( BodyReader )+import           Network.HTTP.Client.Conduit+                 ( HasHttpManager(..)+                 , Manager+                 , Request+                 , Response+                 )+import           Network.HTTP.Client.MultipartFormData ( Part )+import           Network.HTTP.Types+                 ( HeaderName+                 , ResponseHeaders+                 )+import           Network.Reddit.Types.Internal         as M++import           Text.Read                             ( readMaybe )++import           UnliftIO.IORef++import           Web.FormUrlEncoded                    ( Form, ToForm(..) )+import           Web.HttpApiData+                 ( ToHttpApiData(toQueryParam)+                 , showTextData+                 )++-- | The monad tranformer in which Reddit API transactions can be executed+newtype RedditT m a = RedditT (ReaderT Client m a)+    deriving newtype ( Functor, Applicative, Monad, MonadIO, MonadUnliftIO+                     , MonadReader Client, MonadThrow, MonadCatch )++-- | Run a 'RedditT' action+runRedditT :: Client -> RedditT m a -> m a+runRedditT c (RedditT x) = runReaderT x c++-- | Synonym for constraints that 'RedditT' actions must satisfy+type MonadReddit m =+    (MonadUnliftIO m, MonadThrow m, MonadCatch m, MonadReader Client m)++-- | A client facilitating access to Reddit's API+data Client = Client+    { authConfig   :: AuthConfig+    , manager      :: Manager+    , clientState  :: IORef ClientState+    , tokenManager :: Maybe TokenManager+    }+    deriving stock ( Generic )++instance HasHttpManager Client where+    getHttpManager Client { manager } = manager++-- | Stateful data that may be updated over the course of a 'Client' lifetime+data ClientState = ClientState+    { accessToken   :: AccessToken+      -- | The approximate time at which the token was obtained. This is useful+      -- to compare against the @expiresIn@ field of the 'AccessToken'+    , tokenObtained :: POSIXTime+    , limits        :: Maybe RateLimits+    }+    deriving stock ( Show, Eq, Generic )++-- | For conveniently reading some field from the @IORef ClientState@ inside+-- a 'Client'+readClientState :: MonadReddit m => Lens' ClientState a -> m a+readClientState l = asks (^. field @"clientState") >>= readIORef <&> (^. l)++-- | A unique user agent to identify your application; Reddit applies+-- rate-limiting to common agents, and actively bans misleading ones+data UserAgent = UserAgent+    { -- | The target platform+      platform :: Text+      -- | A unique application ID+    , appID    :: Text+    , version  :: Text+      -- | Your username as contact information+    , author   :: Text+    }+    deriving stock ( Show, Eq, Generic )++-- | A client site corresponds to a field in your auth configuration ini file.+-- For instance, the 'ClientSite' \"mybot\" should map to section such as:+--+--  > [MYBOT]+--  > id = <clientID>+--  > ...+--+-- in your @auth.ini@ file.+--+-- __Note__: The 'ClientSite' and the corresponding ini section are case+-- insensitive!+type ClientSite = Text++-- | Rate limit info+data RateLimits = RateLimits+    { -- | The number of requests remaining in the current rate-limiting+      -- window+      remaining   :: Integer+    , used        :: Integer+      -- | Timestamp of the upper bound on rate-limiting counter reset+    , reset       :: POSIXTime+      -- | Epoch time at which the next request should be made in order+      -- to stay within the current rate limit bounds+    , nextRequest :: POSIXTime+    }+    deriving stock ( Show, Eq, Generic )++-- | Extract rate limit info from response headers. This should only be called+-- after making a request+readRateLimits :: POSIXTime -> ResponseHeaders -> Maybe RateLimits+readRateLimits time hs = do+    remaining <- round <$> lookupHeader @Double "x-ratelimit-remaining"+    used <- lookupHeader "x-ratelimit-used"+    reset <- (time +) . fromInteger+        <$> lookupHeader @Integer "x-ratelimit-reset"+    let nextTimeStamp = max 0 . min 10 $ (reset - fromInteger remaining) / 2+        nextRequest   = min reset $ time + nextTimeStamp+    pure RateLimits { .. }+  where+    lookupHeader :: forall a. Read a => HeaderName -> Maybe a+    lookupHeader v = readMaybe @a . C8.unpack =<< lookup v hs++--Auth-------------------------------------------------------------------------+-- | A configuration+data AuthConfig = AuthConfig+    { -- | Your application's client ID+      clientID  :: ClientID+      -- | The type of your application. This will determine how OAuth+      -- credentials are obtained+    , appType   :: AppType+      -- | Your unique user agent; will be used in the client+      -- that is obtained after authenticating+    , userAgent :: UserAgent+    }+    deriving stock ( Show, Eq, Generic )++-- | The three forms of application that may use the Reddit API, each having+-- different API access patterns+data AppType+    = -- | The simplest type of application. May only be used by the developer+      -- who owns the account. This requires supplying the usernme and password+      -- associated with the account+      ScriptApp ClientSecret PasswordFlow+      -- | For applications running on a server backend+    | WebApp ClientSecret CodeFlow+      -- | For applications installed on devices that the developer does not own+      -- (e.g., a mobile application)+    | InstalledApp CodeFlow+      -- Get an access token for read-only access without a user context. This+      -- will grant an 'Unlimited' OAuth scope, but most endpoints will not work.+      -- If accessing endpoints that require a user context, expect HTTP status+      -- exceptions. Additionally, JSON parsing may fail unexpectedly for various+      -- actions.+      --+      -- Note that although this app type is not associated with a user account, it+      -- is still necessary to register the application using your reddit account+    | ApplicationOnly ClientSecret+    deriving stock ( Show, Eq, Generic )++instance ToForm AppType where+    toForm = \case+        ScriptApp _ pf    -> toForm pf+        ApplicationOnly _ -> fromList [ ("grant_type", "client_credentials") ]+        WebApp _ cf       -> toForm cf+        InstalledApp cf   -> toForm cf++-- | Type synonym for client IDs+type ClientID = Text++-- | Type synonym for client secrets+type ClientSecret = Text++-- | Type synonym for the text of a token+type Token = Text++-- | Type synonym for the text of codes returned from auth URLs, for 'WebApp's+-- and 'InstalledApp's+type Code = Text++-- | Token received after authentication+data AccessToken = AccessToken+    { token        :: Token+      -- |+    , expiresIn    :: NominalDiffTime+    , scope        :: [Scope]+    , refreshToken :: Maybe Token+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON AccessToken where+    parseJSON = withObject "AccessToken" $ \o -> AccessToken+        <$> o .: "access_token"+        <*> o .: "expires_in"+        <*> (scopeP =<< o .: "scope")+        <*> o .:? "refresh_token"+      where+        scopeP = withText "Scope"+            $ traverse (parseJSON . String) . splitScopes+          where+            splitScopes t = T.split (`elem` [ ' ', ',' ]) t++-- | Simple user credentials for authenticating via 'ScriptApp's+--+-- __Note__: These credentials will be kept in memory!+data PasswordFlow = PasswordFlow+    { -- | The name of the user you are authenticating as+      username :: Text+      -- | The password of the user you are authenticating as+    , password :: Text+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm PasswordFlow where+    toForm PasswordFlow { .. } =+        fromList [ ("grant_type", "password")+                 , ("username", username)+                 , ("password", password)+                 ]++-- | Details for OAuth \"code flow\", for 'WebApp's and 'InstalledApp's+data CodeFlow = CodeFlow+    { -- | This must exactly match the redirect URL you entered when making+      -- your application on Reddit+      redirectURI :: URL+      -- | This is the code that is obtained after a user grants permissions+      -- by visiting the URL generated by 'Network.Reddit.Auth.getAuthURL'.+      -- If you are using a 'TokenManager' with 'Network.Reddit.newClientWithManager',+      -- you can leave this field as empty text, since it won't be used to+      -- get the initial refresh token+    , code        :: Code+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm CodeFlow where+    toForm CodeFlow { .. } = fromList [ ("code", code)+                                      , ("redirect_uri", redirectURI)+                                      , ("grant_type", "authorization_code")+                                      ]++-- | The duration of the access token for 'WebApp's and 'InstalledApp's+data TokenDuration+    = -- | Generates one-hour access tokens without a refresh token+      Temporary+      -- | Generates a one-hour access tokens with a refresh token+      -- that can be used to indefinitely obtain new access tokens+    | Permanent+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData TokenDuration where+    toQueryParam = showTextData++-- | Monadic actions to load and save 'Token's, specifically refresh tokens, when+-- creating new 'Client's for 'WebApp's and 'InstalledApp's+data TokenManager = TokenManager+    { -- | Load an existing refresh token, for instance from a file or database+      loadToken :: forall m. (MonadIO m, MonadThrow m) => m Token+      -- | Store the new refresh token that is received when exchanging the+      -- existing one for a new 'AccessToken'.+      --+      -- This action must take a @Maybe Token@ as its argument, as it is possible+      -- (albeit perhaps unlikely) that Reddit does not return a new token when+      -- exchanging the existing refresh token for a new access token+    , putToken  :: forall m. (MonadIO m, MonadThrow m) => Maybe Token -> m ()+    }++-- | Represents a specific Reddit functionality that must be explicitly+-- requested+data Scope+    = Accounts -- ^ Corresponds to \"account\" in text form+    | Creddits+    | Edit+    | Flair+    | History+    | Identity+    | LiveManage+    | ModConfig+    | ModContributors+    | ModFlair+    | ModLog+    | ModMail+    | ModOthers+    | ModPosts+    | ModSelf+    | ModTraffic+    | ModWiki+    | MySubreddits+    | PrivateMessages+    | Read+    | Report+    | Save+    | StructuredStyles+    | Submit+    | Subscribe+    | Vote+    | WikiEdit+    | WikiRead+    | Unlimited -- ^ For all scopes, corresponds to \"*\"+    deriving stock ( Generic, Eq, Show, Ord, Enum )++instance FromJSON Scope where+    parseJSON = genericParseJSON defaultOptions { constructorTagModifier }+      where+        constructorTagModifier = \case+            "Unlimited" -> "*"+            "Accounts"  -> "account"+            scope       -> toLower <$> scope++instance ToHttpApiData Scope where+    toQueryParam = \case+        Unlimited -> "*"+        Accounts  -> "account"+        s         -> showTextData s++--Requests---------------------------------------------------------------------+-- | HTTP method, excluding those not used in the Reddit API+data Method+    = GET+    | POST+    | DELETE+    | PUT+    | PATCH+    deriving stock ( Show, Eq, Generic )++-- | Data, either as JSON or URL-encoded form, to be attached to requests+data WithData+    = WithJSON Value+    | WithForm Form+    | WithMultipart [Part]+    | NoData+    deriving stock ( Show, Generic )++-- | An API request parameterized by the type it evaluates to when executed+data APIAction a = APIAction+    { method          :: Method+    , pathSegments    :: [PathSegment]+    , requestData     :: WithData+    , needsAuth       :: Bool+    , followRedirects :: Bool+    , rawJSON         :: Bool+    , checkResponse   :: Request -> Response BodyReader -> IO ()+    }+    deriving stock ( Generic )++-- | Type synonym for a segment of a URL path+type PathSegment = Text
+ src/Network/Reddit/Types/Account.hs view
@@ -0,0 +1,511 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Account+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Account+    ( Username+    , mkUsername+    , UserID(UserID)+    , Account(..)+    , AccountSearchOpts(..)+    , AccountSearchSort(..)+    , Friend(..)+    , FriendList+    , Karma(..)+    , KarmaList+    , Trophy(..)+    , TrophyList+    , UserSummary(..)+    , UserSummaryList+    , Preferences(..)+    , MediaPreference(..)+    , AcceptPMs(..)+    ) where++import           Control.Monad                  ( (<=<) )+import           Control.Monad.Catch            ( MonadThrow )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , Array+                 , FromJSON(..)+                 , Options(fieldLabelModifier, constructorTagModifier)+                 , ToJSON(toJSON)+                 , Value(..)+                 , defaultOptions+                 , genericParseJSON+                 , genericToJSON+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Aeson.Casing              ( snakeCase )+import           Data.Char                      ( toLower )+import           Data.Coerce                    ( coerce )+import           Data.Foldable                  ( asum )+import           Data.Generics.Product          ( HasField(field) )+import qualified Data.HashMap.Strict            as HM+import           Data.Maybe                     ( catMaybes )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import           Data.Time                      ( UTCTime )+import           Data.Traversable               ( for )++import           GHC.Exts                       ( IsList(toList), fromList )+import           GHC.Generics                   ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Subreddit++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"++-- | A unique, site-wide ID for an account+newtype UserID = UserID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance FromJSON UserID where+    parseJSON = withText "UserID" (coerce . dropTypePrefix AccountKind)++instance Thing UserID where+    fullname (UserID uid) = prependType AccountKind uid++-- | Account information. @Maybe@ fields denote data that Reddit sets to null if+-- the requester does not own the account in question. Note that this does /not/+-- include all of the possible fields that may be present in Reddit's response -+-- which are quite numerous in total and poorly documented+data Account = Account+    { userID           :: UserID+    , username         :: Username+    , created          :: UTCTime+    , commentKarma     :: Int+    , isGold           :: Bool+    , isMod            :: Bool+    , linkKarma        :: Int+    , inboxCount       :: Maybe Integer+    , modHash          :: Maybe Text+    , over18           :: Maybe Bool+    , hasMail          :: Maybe Bool+    , hasModMail       :: Maybe Bool+    , hasVerifiedEmail :: Maybe Bool+    }+    deriving stock ( Show, Generic )++instance FromJSON Account where+    parseJSON v = asum [ withObject "Account" accountP v+                       , withKind AccountKind "Account" accountP v+                       ]+      where+        accountP o = Account <$> (o .: "id")+            <*> o .: "name"+            <*> (integerToUTC <$> o .: "created_utc")+            <*> o .: "comment_karma"+            <*> o .: "is_gold"+            <*> o .: "is_mod"+            <*> o .: "link_karma"+            <*> o .:? "inbox_count"+            <*> o .:? "modhash"+            <*> o .:? "over_18"+            <*> o .:? "has_mail"+            <*> o .:? "has_mod_mail"+            <*> o .:? "has_verified_email"++instance Paginable Account where+    type PaginateOptions Account = AccountSearchOpts++    type PaginateThing Account = UserID++    defaultOpts = AccountSearchOpts+        { resultSort      = RelevantAccounts+        , typeaheadActive = Nothing+        , searchQueryID   = Nothing+        }++    getFullname Account { userID } = userID++-- | Options for search @Listing@s of 'Account's+data AccountSearchOpts = AccountSearchOpts+    { resultSort      :: AccountSearchSort+    , typeaheadActive :: Maybe Bool+      -- | A UUID. This is not clearly documented in the API docs. Presumably,+      -- it refers to an identifier for an existing search+    , searchQueryID   :: Maybe Text+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm AccountSearchOpts where+    toForm AccountSearchOpts { .. } = fromList+        $ [ ("sort", toQueryParam resultSort) ]+        <> catMaybes [ ("typeahead_active", ) . toQueryParam+                       <$> typeaheadActive+                     , ("search_query_id", ) . toQueryParam <$> searchQueryID+                     ]++-- | The item sort for 'Account' searches+data AccountSearchSort+    = RelevantAccounts+    | ActiveAccounts+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData AccountSearchSort where+    toQueryParam = \case+        RelevantAccounts -> "relevance"+        ActiveAccounts   -> "activity"++-- | A user\'s friend+data Friend = Friend+    { username :: Username+    , userID   :: UserID+    , since    :: UTCTime+    , note     :: Maybe Text+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Friend where+    parseJSON = withObject "Friend" $ \o -> Friend <$> o .: "name"+        <*> o .: "id"+        <*> (integerToUTC <$> o .: "date")+        <*> (maybe (pure Nothing) nothingTxtNull =<< o .:? "note")++-- | Wrapper for parsing JSON objects listing 'Friend's+newtype FriendList = FriendList (Seq Friend)+    deriving stock ( Show, Generic )++instance FromJSON FriendList where+    parseJSON = withKind UserListKind "FriendList"+        $ fmap (FriendList . fromList) . (friendsP <=< (.: "children"))+      where+        friendsP = withArray "[Friend]" (traverse parseJSON . toList)++-- | Information about a user\'s karma+data Karma = Karma+    { subreddit    :: SubredditName+    , commentKarma :: Integer+    , linkKarma    :: Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Karma where+    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "subreddit" -> "sr"+            s           -> snakeCase s++-- | Wrapper for parsing JSON array of 'Karma'+newtype KarmaList = KarmaList (Seq Karma)+    deriving stock ( Show, Generic )++instance FromJSON KarmaList where+    parseJSON = withKind @Array KarmaListKind "KarmaList"+        $ fmap (KarmaList . fromList) . traverse parseJSON . toList++-- | A Reddit award, such as the \"one-year club\"+data Trophy = Trophy+    { name        :: Name+    , trophyID    :: Maybe Text+    , awardID     :: Maybe Text+    , description :: Maybe Body+    , grantedAt   :: Maybe UTCTime+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Trophy where+    parseJSON = withKind AwardKind "Trophy" $ \o -> Trophy <$> o .: "name"+        <*> o .:? "id"+        <*> o .:? "award_id"+        <*> o .:? "description"+        <*> (fmap integerToUTC <$> o .:? "granted_at")++-- | Wrapper for parsing JSON objects listing 'Trophy's+newtype TrophyList = TrophyList (Seq Trophy)+    deriving stock ( Show, Generic )++instance FromJSON TrophyList where+    parseJSON = withKind TrophyListKind "TrophyList"+        $ fmap (TrophyList . fromList) . (trophiesP <=< (.: "trophies"))+      where+        trophiesP = withArray "[Trophy]" (traverse parseJSON . toList)++-- | A brief summary of a user, with significantly less information than a+-- 'Account'+data UserSummary = UserSummary+    { -- | This field will be absent unless the 'UserSummary' is obtained from a+      -- specific endpoint using 'Network.Reddit.Actions.Account.getUserSummaries'.+      -- User summaries are sent as a JSON object with the user IDs as keys, so+      -- this field doesn't exist until the larger structure is parsed+      userID         :: Maybe UserID+    , name           :: Username+    , commentKarma   :: Integer+    , linkKarma      :: Integer+    , created        :: UTCTime+    , profilePicture :: URL+    , profileColor   :: Maybe RGBText+    , profileOver18  :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON UserSummary where+    parseJSON = withObject "UserSummary" $ \o -> UserSummary Nothing+        <$> o .: "name"+        <*> o .: "comment_karma"+        <*> o .: "link_karma"+        <*> (integerToUTC <$> o .: "created_utc")+        <*> (o .: "profile_img")+        <*> (nothingTxtNull =<< o .: "profile_color")+        <*> o .: "profile_over_18"++-- | Wrapper for parsing a JSON object of 'UserSummary's which has user IDs as+-- keys+newtype UserSummaryList = UserSummaryList (Seq UserSummary)+    deriving stock ( Show, Generic )++instance FromJSON UserSummaryList where+    parseJSON = withObject "UserSummaryList"+        $ fmap (UserSummaryList . fromList) . userSummariesP+      where+        userSummariesP o = for (HM.toList o) $ \(usid, us) -> do+            uid <- parseJSON (String usid)+            u <- parseJSON us+            pure $ u & field @"userID" ?~ uid++-- | User preferences+data Preferences = Preferences+    {  -- | Default comment sort+      defaultCommentSort :: ItemSort+      -- | Thumbnail preference+    , media :: MediaPreference+      -- | Media preview preference+    , mediaPreview :: MediaPreference+      -- | Minimum score for displaying comments, must be between -100 and 100+    , minCommentScore :: Int+      -- | Minimum score for displaying submissions, must be between -100 and 100+    , minLinkScore :: Int+      -- | Default number of comments to display, must be between 1 and 500+    , numComments :: Int+      -- | Number of submissions to display at once, must be between 1 and 100+    , numSites :: Int+      -- | Interface language, should be in IETF format, with components+      -- separated with underscores+    , lang :: Text+      -- | If @True@, all users can send PMs. Otherwise, only whitelisted+      -- users can+    , acceptPMs :: AcceptPMs+      -- | Allows Reddit to use activity to show more relevant ads+    , activityRelevantAds :: Bool+      -- | Allows Reddit to log outbound clicks for personalization+    , allowClicktracking :: Bool+      -- | Enrolls user in beta testing Reddit features+    , beta :: Bool+      -- | Show recently viewed links+    , clickGadget :: Bool+      -- | Collapse messages after reading them+    , collapseReadMessages :: Bool+      -- | Compress link display+    , compress :: Bool+      -- | Use creddit to automatically renew gold upon expiration+    , credditAutorenew :: Maybe Bool+      -- | Show additional details in domain text if applicable (e.g.+      -- source subreddit, author URL, etc...)+    , domainDetails :: Bool+      -- | Send email notifications for chat requests+    , emailChatRequest :: Bool+      -- | Send email notifications for comments replies+    , emailCommentReply :: Bool+      -- | Send email digests+    , emailDigests :: Bool+      -- | Send email notifications for messages+    , emailMessages :: Bool+      -- | Send email notifications for submission replies+    , emailPostReply :: Bool+      -- | Send email notifications for PMs+    , emailPrivateMessage :: Bool+      -- | Unsubscribe from all emails+    , emailUnsubscribeAll :: Bool+      -- | Send email notifications for comment upvotes+    , emailUpvoteComment :: Bool+      -- | Send email notifications for submission upvotes+    , emailUpvotePost :: Bool+      -- | Send email notifications for new followers+    , emailUserNewFollower :: Bool+      -- | Send email notifications for user mentions+    , emailUsernameMention :: Bool+    , enableDefaultThemes :: Bool+      -- | Enable feed recommendations+    , feedRecommendationsEnabled :: Bool+    , hideAds :: Bool+      -- | Don't show submissions after downvoting them+    , hideDowns :: Bool+      -- | Disallow search engine profile indexing+    , hideFromRobots :: Bool+      -- | Don't show submissions after upvoting them+    , hideUps :: Bool+      -- | Show a dagger on comments voted controversial+    , highlightControversial :: Bool+      -- | Highlight new comments+    , highlightNewComments :: Bool+      -- | Ignore suggested sorts+    , ignoreSuggestedSort :: Bool+    , inRedesignBeta :: Maybe Bool+      -- | Label NSFTW submissions+    , labelNSFW :: Bool+      -- | Show the legacy search page+    , legacySearch :: Bool+      -- | Send browser message notifications+    , liveOrangereds :: Bool+      -- | Mark messages as read after opening the inbox+    , markMessagesRead :: Bool+      -- | Receive a notification when your username is mentioned by others+    , monitorMentions :: Bool+      -- | Open links in a new window+    , newWindow :: Bool+      -- | Enable night mode+    , nightMode :: Bool+      -- | Hide thumbnails and media previews for NSFW content+    , noProfanity :: Bool+      -- | Show the spotlight box on the home feed+    , organic :: Maybe Bool+      -- | Affirm age and willingness to view adult content+    , over18 :: Bool+      -- | Enable private RSS feeds+    , privateFeeds :: Bool+      -- | View user profiles on desktop using legacy mode+    , profileOptOut :: Bool+      -- | Make votes public+    , publicVotes :: Bool+      -- | Allow data to be used for \"research\" purposes+    , research :: Bool+      -- | Include NSFW content in search results+    , searchIncludeOver18 :: Bool+      -- | Send crosspost messages+    , sendCrosspostMessages :: Bool+      -- | Send welcome messages+    , sendWelcomeMessages :: Bool+      -- | Show user flair+    , showFlair :: Bool+      -- | Show remaining gold on userpage+    , showGoldExpiration :: Bool+      -- | Show link flair+    , showLinkFlair :: Bool+      -- | Show location-based recommendations+    , showLocationBasedRecommendations :: Bool+      -- | Show presence+    , showPresence :: Bool+    , showPromote :: Maybe Bool+      -- | Allow subreddits to display custom themes+    , showStylesheets :: Bool+      -- | Show trending subreddits+    , showTrending :: Bool+      -- | Show a link to your Twitter account on your profile+    , showTwitter :: Bool+      -- | Store visits+    , storeVisits :: Bool+      -- | Allow Reddit to use 3rd-party data to show more relevant ads+    , thirdPartyDataPersonalizedAds :: Bool+      -- | Allow ad personalization+    , thirdPartyPersonalizedAds :: Bool+      -- | Allow ad personalization using 3rd-party data+    , thirdPartySiteDataPersonalizedAds :: Bool+      -- | Allow content personalization using 3rd-party data+    , thirdPartySiteDataPersonalizedContent :: Bool+      -- | Show message conversations in the inbox+    , threadedMessages :: Bool+      -- | Enable threaded modmail display+    , threadedModmail :: Bool+    , topKarmaSubreddits :: Bool+    , useGlobalDefaults :: Bool+      -- | Autoplay Reddit videos on the desktop comments page+    , videoAutoplay :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Preferences where+    parseJSON = genericParseJSON --+        defaultOptions { fieldLabelModifier = preferencesModifier }++instance ToJSON Preferences where+    toJSON = genericToJSON --+        defaultOptions { fieldLabelModifier = preferencesModifier }++preferencesModifier :: Modifier+preferencesModifier = \case+    "nightMode" -> "nightmode"+    "over18" -> "over_18"+    "searchIncludeOver18" -> "search_include_over_18"+    "numSites" -> "numsites"+    "newWindow" -> "newwindow"+    "acceptPMs" -> "accept_pms"+    "clickGadget" -> "clickgadget"+    "labelNSFW" -> "label_nsfw"+    s -> snakeCase s++-- | How to deal with media previews and thumbnails in your 'Preferences'+data MediaPreference+    = TurnOn+    | TurnOff+    | FollowSubreddit+    deriving stock ( Show, Eq, Generic )++instance FromJSON MediaPreference where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = mediaPreferenceModifier }++instance ToJSON MediaPreference where+    toJSON = genericToJSON --+        defaultOptions { constructorTagModifier = mediaPreferenceModifier }++mediaPreferenceModifier :: Modifier+mediaPreferenceModifier = \case+    "TurnOn"          -> "on"+    "TurnOff"         -> "off"+    "FollowSubreddit" -> "subreddit"+    s                 -> s++-- | Policy for accepting private messages, for use in user 'Preferences'+data AcceptPMs+    = Everyone+    | Whitelisted+    deriving stock ( Show, Eq, Generic )++instance FromJSON AcceptPMs where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = fmap toLower }++instance ToJSON AcceptPMs where+    toJSON = genericToJSON --+        defaultOptions { constructorTagModifier = fmap toLower }
+ src/Network/Reddit/Types/Comment.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Comment+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Comment+    ( Comment(..)+    , CommentID(CommentID)+    , MoreComments(..)+    , ChildComment(..)+    , WithChildren+    , WithReplies+    , commentP+    , LoadedChildren+    ) where++import           Control.Monad                   ( (<=<) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , Object+                 , Value(Object, String)+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Aeson.Types                ( Parser )+import           Data.Coerce                     ( coerce )+import           Data.Generics.Product           ( HasField(field) )+import           Data.Sequence                   ( Seq((:<|)) )+import           Data.Text                       ( Text )+import           Data.Time                       ( UTCTime )++import           GHC.Exts                        ( IsList(toList, fromList) )+import           GHC.Generics                    ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Submission ( SubmissionID )+import           Network.Reddit.Types.Subreddit++import           Web.HttpApiData                 ( ToHttpApiData(..) )++-- | A 'Comment' ID+newtype CommentID = CommentID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, Ord, ToHttpApiData )++instance FromJSON CommentID where+    parseJSON = withText "CommentID" (coerce . dropTypePrefix CommentKind)++instance Thing CommentID where+    fullname (CommentID cid) = prependType CommentKind cid++-- | A Reddit comment+data Comment = Comment+    { commentID     :: CommentID+    , author        :: Username+    , body          :: Body+    , bodyHTML      :: Body+      -- | This field will be empty unless the comment was obtained+      -- via 'Network.Reddit.Comment.withReplies'+    , replies       :: Seq ChildComment+    , score         :: Maybe Integer+    , ups           :: Maybe Integer+    , downs         :: Maybe Integer+    , created       :: UTCTime+    , edited        :: Maybe UTCTime+    , subreddit     :: SubredditName+    , subredditID   :: SubredditID+    , gilded        :: Int+    , scoreHidden   :: Maybe Bool+    , linkID        :: SubmissionID+    , linkURL       :: Maybe URL+    , linkAuthor    :: Maybe Username+    , permaLink     :: URL+    , userReports   :: Seq ItemReport+    , modReports    :: Seq ItemReport+    , numReports    :: Maybe Integer+    , distinguished :: Maybe Distinction+      -- | Whether the author of the comment is also the submission author+    , isSubmitter   :: Bool+    , stickied      :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Comment where+    parseJSON = withKind CommentKind "Comment" commentP++-- | Parse a 'Comment'+commentP :: Object -> Parser Comment+commentP o = do+    commentID <- o .: "id"+    author <- o .: "author"+    body <- o .: "body"+    bodyHTML <- o .: "body_html"+    replies <- repliesP =<< o .: "replies"+    score <- o .:? "score"+    ups <- o .:? "ups"+    downs <- o .:? "downs"+    created <- integerToUTC <$> o .: "created_utc"+    edited <- editedP =<< o .: "edited"+    subreddit <- o .: "subreddit"+    subredditID <- o .: "subreddit_id"+    gilded <- o .: "gilded"+    scoreHidden <- o .:? "score_hidden"+    linkID <- o .: "link_id"+    linkURL <- o .:? "link_url"+    linkAuthor <- o .:? "link_author"+    permaLink <- o .: "permalink"+    userReports <- o .: "user_reports"+    modReports <- o .: "mod_reports"+    numReports <- o .:? "num_reports"+    distinguished <- o .:? "distinguished"+    isSubmitter <- o .: "is_submitter"+    stickied <- o .: "stickied"+    pure Comment { .. }+  where+    repliesP (String _)   = pure mempty+    repliesP v@(Object _) = parseJSON @(Listing CommentID ChildComment) v+        <&> (^. field @"children")+    repliesP _            = mempty++instance Paginable Comment where+    type PaginateOptions Comment = ItemOpts Comment++    type PaginateThing Comment = CommentID++    defaultOpts = defaultItemOpts++    getFullname Comment { commentID } = commentID++-- | This wraps the 'ChildComment's of a 'Network.Reddit.Types.Submission.Submission'+newtype WithChildren = WithChildren (Seq ChildComment)+    deriving stock ( Show, Eq, Generic )++instance FromJSON WithChildren where+    parseJSON = withArray "WithChildren" (parseWithComments . toList)+      where+        parseWithComments [ _, cs ] = WithChildren+            <$> (parseJSON @(Listing CommentID ChildComment) cs+                 <&> (^. field @"children"))+        parseWithComments _         = mempty++-- | This wraps a 'Comment' which has been fetched with its 'ChildComment's+newtype WithReplies = WithReplies Comment+    deriving stock ( Show, Eq, Generic )++instance FromJSON WithReplies where+    parseJSON = withArray "WithReplies" (parseWithReplies . toList)+      where+        parseWithReplies [ _, cs ] = do+            Listing { children } <- parseJSON @(Listing CommentID Comment) cs+            case children of+                c :<| _ -> pure $ WithReplies c+                _       -> mempty++        parseWithReplies _         = mempty++-- | Represents a comments on a submission or replies to a comment, which can+-- be actual 'Comment's, or a list of children corresponding to \"load more\"+-- or \"continue this thread\" links on Reddit's UI+data ChildComment+    = TopLevel Comment+    | More MoreComments+    deriving stock ( Show, Eq, Generic )++instance FromJSON ChildComment where+    parseJSON = withObject "ChildComment" $ \o -> o .: "kind" >>= \case+        k+            | k == CommentKind -> TopLevel <$> parseJSON (Object o)+            | k == MoreKind -> More <$> parseJSON (Object o)+            | otherwise -> mempty++newtype LoadedChildren = LoadedChildren (Seq ChildComment)+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance FromJSON LoadedChildren where+    parseJSON = withObject "LoadedChildren" $ \o -> LoadedChildren . fromList+        <$> (loadedP =<< ((.: "things") =<< (.: "data") =<< o .: "json"))+      where+        loadedP = withArray "[ChildComment]" (traverse parseJSON . toList)++-- | A link to load more children 'Comment's+data MoreComments = MoreComments+    { childIDs :: Seq CommentID+      -- | The number of \"collapsed\" comments that can be loaded+    , count    :: Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON MoreComments where+    parseJSON = withObject "MoreComments" $ parseMore <=< (.: "data")+      where+        parseMore o = MoreComments <$> o .: "children" <*> o .: "count"
+ src/Network/Reddit/Types/Emoji.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Types.Emoji+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Emoji+    ( Emoji(..)+    , mkEmoji+    , NewEmoji+    , EmojiName+    , mkEmojiName+    , EmojiList+    ) where++import           Control.Monad.Catch            ( MonadThrow )++import           Data.Aeson+                 ( (.:)+                 , FromJSON(..)+                 , Value(..)+                 , withObject+                 )+import           Data.Coerce                    ( coerce )+import           Data.Generics.Product+import qualified Data.HashMap.Strict            as HM+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import           Data.Traversable               ( for )++import           GHC.Exts                       ( IsList(fromList) )+import           GHC.Generics                   ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Subreddit++import           Web.FormUrlEncoded             ( ToForm(..) )+import           Web.HttpApiData                ( ToHttpApiData(toQueryParam)+                                                )++-- | A single emoji. This can either be one of Reddit\'s builtin \"snoomojis\"+-- or a custom emoji for a subreddit. See 'mkEmoji' for creating news ones+data Emoji = Emoji+    { -- | Depending on how the emoji was obtained, this field may be empty,+      -- as names must be taken from keys of a larger JSON object+      name             :: EmojiName+      -- | This field will be present when obtaining existing emojis, but+      -- should be left empty when creating new ones+    , modFlairOnly     :: Bool+    , postFlairAllowed :: Bool+    , userFlairAllowed :: Bool+      -- | Points to a Reddit-hosted image. This will be present for+      --  existing emoji, but should be left empty when creating them+    , createdBy        :: Maybe UserID+    , url              :: Maybe UploadURL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Emoji where+    parseJSON = withObject "Emoji" $ \o -> Emoji mempty+        <$> o .: "mod_flair_only"+        <*> o .: "post_flair_allowed"+        <*> o .: "user_flair_allowed"+        <*> o .: "created_by"+        <*> o .: "url"++instance ToForm Emoji where+    toForm Emoji { .. } =+        fromList [ ("mod_flair_only", toQueryParam modFlairOnly)+                 , ("post_flair_allowed", toQueryParam postFlairAllowed)+                 , ("user_flair_allowed", toQueryParam userFlairAllowed)+                 ]++-- | Wrapper for creating new 'Emoji's, which includes the @name@ field+newtype NewEmoji = NewEmoji Emoji+    deriving stock ( Show, Generic )++instance ToForm NewEmoji where+    toForm (NewEmoji emoji@Emoji { name }) =+        toForm emoji <> fromList [ ("name", toQueryParam name) ]++-- | Create a new 'Emoji' by providing an 'EmojiName'; default values are provided+-- for all other fields+mkEmoji :: EmojiName -> Emoji+mkEmoji name = Emoji+    { createdBy        = Nothing+    , url              = Nothing+    , modFlairOnly     = False+    , postFlairAllowed = True+    , userFlairAllowed = True+    , ..+    }++-- | The name of an individual 'Emoji'+newtype EmojiName = EmojiName Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, Semigroup, Monoid, FromJSON, ToHttpApiData )++-- | Smart constructor for 'EmojiName's, which may only contain alphanumeric characters,+-- \'_\', \'-\', and \'&\', and may not exceed 24 characters in length+mkEmojiName :: MonadThrow m => Text -> m EmojiName+mkEmojiName = validateName (Just [ '_', '-', '&' ]) (Just (1, 24)) "EmojiName"++-- | Wrapper for parsing response JSON. Subreddit emojis must be extracted from a+-- larger structure+newtype EmojiList = EmojiList (Seq Emoji)+    deriving stock ( Show, Generic )++instance FromJSON EmojiList where+    parseJSON = withObject "EmojiList"+        $ fmap (EmojiList . fromList) . emojiListP+      where+        emojiListP o = case HM.toList o of+            [ _, (sid, Object es) ] -> for (HM.toList es) $ \(n, e) ->+                -- HACK make sure that this is a valid subreddit ID+                parseJSON @SubredditID (String sid) --+                >> parseJSON @Emoji e+                <&> field @"name" .~ coerce n+            _ -> mempty
+ src/Network/Reddit/Types/Flair.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Flair+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Flair+    ( AssignedFlair(..)+    , FlairTemplate(..)+    , defaultFlairTemplate+    , PostedFlairTemplate+    , FlairID+    , FlairText+    , mkFlairText+    , FlairSelection(..)+    , FlairChoice(..)+    , UserFlair(..)+    , ForegroundColor(..)+    , FlairResult(..)+    , CurrentUserFlair+    , FlairChoiceList+    , FlairList(..)+    , flairlistToListing+    , FlairContent(..)+    , FlairType(..)+    , CSSClass+    ) where++import           Control.Monad.Catch            ( MonadThrow(throwM) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , Options(constructorTagModifier)+                 , ToJSON(..)+                 , Value(String)+                 , defaultOptions+                 , genericParseJSON+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Char                      ( toLower )+import           Data.HashMap.Strict            ( HashMap )+import           Data.Maybe                     ( catMaybes )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import qualified Data.Text                      as T++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++import           Web.FormUrlEncoded             ( ToForm(..) )+import           Web.HttpApiData                ( ToHttpApiData(toQueryParam)+                                                , showTextData+                                                )++-- | The text displayed by the 'FlairTemplate'+newtype FlairText = FlairText Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON, ToJSON, ToHttpApiData, Semigroup, Monoid )++-- | Smart constructor for 'FlairText', the length of which not exceed 64+-- characters+mkFlairText :: MonadThrow m => Text -> m FlairText+mkFlairText txt+    | T.length txt > 64 = throwM+        $ OtherError "mkFlairText: Text length may not exceed 64 characters"+    | otherwise = pure $ FlairText txt++-- | CSS class for flair+type CSSClass = Text++-- | Flair that has been, or will be, assigned to a user+data AssignedFlair = AssignedFlair+    { user     :: Username+    , text     :: Maybe FlairText+    , cssClass :: Maybe CSSClass --+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON AssignedFlair where+    parseJSON = withObject "AssignedFlair" $ \o -> AssignedFlair+        <$> o .: "user"+        <*> o .:? "flair_text"+        <*> o .:? "flair_css_class"++-- The endpoints that list assigned flairs are a @Listing@, but there are no+-- additional options that can be passed to them. Giving this dummy instance at+-- least allows using a @Listing ... AssignedFlair@ with existing convenience+-- functions+instance Paginable AssignedFlair where+    type PaginateOptions AssignedFlair = ()++    type PaginateThing AssignedFlair = Text++    defaultOpts = ()++    optsToForm _ = mempty++-- | Reddit strangely does /not/ use their usual @Listing@ mechanism for paginating+-- assigned flairs, but a different data structure+data FlairList = FlairList+    { prev  :: Maybe UserID+    , next  :: Maybe UserID+    , users :: Seq AssignedFlair  --+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON FlairList where+    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+flairlistToListing :: FlairList -> Listing UserID AssignedFlair+flairlistToListing (FlairList p n us) = Listing p n us++-- | An identifier for a 'FlairTemplate'+type FlairID = Text++-- | Flair \"templates\" that describe choices for self-assigned flair, for both+-- users and submissions+data FlairTemplate = FlairTemplate+    { flairID          :: Maybe FlairID+    , text             :: FlairText+    , textEditable     :: Bool+    , textColor        :: Maybe ForegroundColor+    , backgroundColor  :: Maybe RGBText+    , cssClass         :: Maybe CSSClass+    , overrideCSS      :: Maybe Bool+      -- | Should be between 1 and 10; 10 is the default+    , maxEmojis        :: Word+    , modOnly          :: Bool+    , allowableContent :: FlairContent+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON FlairTemplate where+    parseJSON = withObject "FlairTemplate" $ \o -> FlairTemplate <$> o .: "id"+        <*> o .: "text"+        <*> o .: "text_editable"+        <*> (nothingTxtNull =<< o .: "text_color")+        <*> (nothingTxtNull =<< o .: "background_color")+        <*> (nothingTxtNull =<< o .: "css_class")+        <*> o .:? "override_css"+        <*> o .: "max_emojis"+        <*> o .: "mod_only"+        <*> o .: "allowable_content"++-- | Wrapper around @FlairTemplates@ for posting via the API. If the @flairID@ field+-- is @Nothing@, a new template will be created. Otherwise, the template with the+-- matching ID will be updated+newtype PostedFlairTemplate = PostedFlairTemplate FlairTemplate+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance ToForm PostedFlairTemplate where+    toForm (PostedFlairTemplate ft@FlairTemplate { flairID }) = toForm ft+        <> fromList (foldMap pure (("flair_template_id", ) <$> flairID))++instance ToForm FlairTemplate where+    toForm FlairTemplate { .. } = fromList+        $ [ ("allowable_content", toQueryParam allowableContent)+          , ("max_emojis", toQueryParam maxEmojis)+          , ("mod_only", toQueryParam modOnly)+          , ("override_css", toQueryParam overrideCSS)+          , ("text", toQueryParam text)+          , ("text_editable", toQueryParam textEditable)+          , ("api_type", "json")+          ]+        <> catMaybes [ ("background_color", ) . toQueryParam+                       <$> backgroundColor+                     , ("text_color", ) . toQueryParam <$> textColor+                     , ("css_class", ) . toQueryParam <$> cssClass+                     ]++-- | A 'FlairTemplate' with default fields, for convenience when creating new+-- templates+defaultFlairTemplate :: FlairTemplate+defaultFlairTemplate = FlairTemplate+    { flairID          = Nothing+    , text             = mempty+    , textEditable     = False+    , textColor        = Just Light+    , backgroundColor  = Nothing+    , cssClass         = Nothing+    , overrideCSS      = Just False+    , maxEmojis        = 10+    , modOnly          = False+    , allowableContent = AllContent+    }++-- | Information about flair that a user can choose. The @templateID@ corresponds+-- to the @flairID@ field of a 'FlairTemplate'+data FlairChoice = FlairChoice+    { templateID   :: FlairID+    , text         :: FlairText+    , textEditable :: Bool+    , cssClass     :: Maybe CSSClass+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON FlairChoice where+    parseJSON = withObject "FlairChoice" $ \o -> FlairChoice+        <$> o .: "flair_template_id"+        <*> o .: "flair_text"+        <*> o .: "flair_text_editable"+        <*> (nothingTxtNull =<< o .: "flair_css_class")++-- Reddit returns both the current flair for the user along with the choices for+-- flair on the given subreddit. This wrapper extracts the possible choices from+-- the returned JSON+newtype FlairChoiceList = FlairChoiceList (Seq FlairChoice)+    deriving stock ( Show, Generic )++instance FromJSON FlairChoiceList where+    parseJSON = withObject "FlairChoiceList" $ \o ->+        FlairChoiceList . fromList <$> (flairChoiceP =<< (o .: "choices"))+      where+        flairChoiceP = withArray "[FlairChoice]" (traverse parseJSON . toList)++-- | Flair that is currently assigned to a user+data UserFlair = UserFlair+    { text     :: Maybe FlairText  --+    , cssClass :: Maybe CSSClass+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON UserFlair where+    parseJSON = withObject "UserFlair" $ \o ->+        UserFlair <$> (o .: "flair_text") <*> (o .: "flair_css_class")++-- | Wrapper around @UserFlair@ for fetching the current flair. This uses the same+-- endpoint as the @FlairChoiceList@ above+newtype CurrentUserFlair = CurrentUserFlair UserFlair+    deriving stock ( Show, Generic )++instance FromJSON CurrentUserFlair where+    parseJSON = withObject "CurrentUserFlair" $ \o -> CurrentUserFlair+        <$> (currentP =<< (o .: "current"))+      where+        currentP = parseJSON++-- | Select a 'FlairChoice' for a submission or for the user+data FlairSelection = FlairSelection+    { flairChoice :: FlairChoice+      -- | If @Just@ and if the @textEditable@ field of the 'FlairChoice' is+      -- @True@, this will be sent. It is otherwise ignored+    , text        :: Maybe Text+    , subreddit   :: SubredditName+    }+    deriving stock ( Show, Eq, Generic )++-- | The result of bulk setting of users\' flairs as a mod action. The @warnings@+-- and @errors@ fields may be dynamically generated by Reddit, so they are+-- represented here as 'HashMap's+data FlairResult = FlairResult+    {  -- | If the flair was applied or not+      ok       :: Bool+      -- | A human-readable description of the transaction+    , status   :: Text+    , warnings :: HashMap Text Text+    , errors   :: HashMap Text Text+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON FlairResult where+    parseJSON = withObject "FlairResult" $ \o -> FlairResult <$> o .: "ok"+        <*> o .: "status"+        <*> o .: "warnings"+        <*> o .: "errors"++-- | The type of flair, when creating a new template+data FlairType+    = UserFlairType+    | SubmissionFlairType+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData FlairType where+    toQueryParam = \case+        UserFlairType       -> "USER_FLAIR"+        SubmissionFlairType -> "LINK_FLAIR"++-- | The type of content that is allowed in a flair template+data FlairContent+    = AllContent+    | EmojisOnly+    | TextOnly+    deriving stock ( Show, Eq, Generic )++instance FromJSON FlairContent where+    parseJSON = withText "FlairContent" $ \case+        "all"   -> pure AllContent+        "emoji" -> pure EmojisOnly+        "text"  -> pure TextOnly+        _       -> mempty++instance ToHttpApiData FlairContent where+    toQueryParam = \case+        AllContent -> "all"+        EmojisOnly -> "emoji"+        TextOnly   -> "text"++-- | Foreground color for v2 flair+data ForegroundColor+    = Dark+    | Light+    deriving stock ( Show, Eq, Generic )++instance FromJSON ForegroundColor where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = fmap toLower }++instance ToJSON ForegroundColor where+    toJSON = String . showTextData++instance ToHttpApiData ForegroundColor where+    toQueryParam = showTextData
+ src/Network/Reddit/Types/Internal.hs view
@@ -0,0 +1,756 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      : Network.Reddit.Types.Internal+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Internal+    ( Thing(..)+    , RedditKind(..)+    , Paginable(..)+    , Paginator(..)+    , Listing(..)+    , CIText(CIText)+    , HKD+    , ItemOpts(..)+    , defaultItemOpts+    , ItemSort(..)+    , ItemReport(..)+    , Distinction(..)+    , Time(..)+    , ItemType(..)+    , UploadURL+    , Body+    , Title+    , URL+    , Subject+    , RGBText+    , Name+    , Domain+    , Modifier+    , RawBody+      -- * Exceptions+    , RedditException+    , ClientException(..)+    , APIException(..)+    , OAauthError(..)+    , ErrorMessage(..)+    , StatusCode+    , StatusMessage(..)+    , JSONError(..)+      -- * Utilities+    , dropTypePrefix+    , integerToUTC+    , withKind+    , textKind+    , prependType+    , bshow+    , tshow+    , editedP+    , validateName+    , joinParams+    , nothingTxtNull+    , textObject+    , textEncode+    , withKinds+    , breakOnType+    , getVals+    , mkTextForm+    ) where++import           Conduit                      ( ConduitM )++import           Control.Exception            ( Exception(..), SomeException )+import           Control.Monad                ( guard )+import           Control.Monad.Catch          ( MonadThrow(throwM) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , Options(constructorTagModifier)+                 , ToJSON(toJSON)+                 , Value(..)+                 , defaultOptions+                 , genericParseJSON+                 , genericToJSON+                 , object+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Aeson.Text              ( encodeToLazyText )+import           Data.Aeson.Types             ( Pair, Parser )+import           Data.Bool                    ( bool )+import           Data.ByteString              ( ByteString )+import qualified Data.ByteString.Char8        as C8+import qualified Data.ByteString.Lazy         as LB+import           Data.Char                    ( toLower )+import           Data.Coerce                  ( coerce )+import           Data.Data                    ( cast )+import           Data.Foldable                ( asum )+import qualified Data.Foldable                as F+import           Data.Function                ( on )+import           Data.Functor.Identity        ( Identity )+import qualified Data.Generics.Product.Fields as GL+import           Data.HashMap.Strict          ( HashMap )+import qualified Data.HashMap.Strict          as HM+import           Data.Ix                      ( Ix(inRange) )+import           Data.Kind                    ( Type )+import           Data.Maybe                   ( catMaybes, fromMaybe )+import           Data.Scientific              ( toBoundedInteger )+import           Data.Sequence                ( Seq )+import           Data.Text                    ( Text )+import qualified Data.Text                    as T+import qualified Data.Text.Lazy               as LT+import           Data.Time                    ( UTCTime )+import           Data.Time.Clock.POSIX        ( posixSecondsToUTCTime )++import           GHC.Exts                     ( Coercible+                                              , IsList(fromList, toList)+                                              )+import           GHC.Generics                 ( Generic )++import           Network.HTTP.Conduit         ( Request )++import           Web.FormUrlEncoded           ( Form, ToForm(..) )+import           Web.HttpApiData              ( ToHttpApiData(..)+                                              , showTextData+                                              )++-- | A @RedditKind@ represents a textual prefix that Reddit uses to denote types+-- in its API+data RedditKind+    = CommentKind -- @t1_@+    | AccountKind -- @t2_@+    | SubmissionKind -- @t3_@+    | MessageKind -- @t4_@+    | SubredditKind -- @t5_@+    | AwardKind -- @t6_@+    | ListingKind -- @Listing@+    | UserListKind -- @UserList@+    | KarmaListKind -- @KarmaList@+    | TrophyListKind -- @TrophyList@+    | MoreKind -- @more@+    | RelKind -- @rb@+    | SubredditSettingsKind -- @subreddit_settings@+    | StylesheetKind -- @stylesheet@+    | WikiPageKind -- @wikipage@+    | WikiPageListingKind -- @wikipagelisting@+    | WikiPageSettingsKind -- @wikipagesettings@+    | LabeledMultiKind -- @LabeledMulti@+    | ModActionKind -- @modaction@+    | LiveThreadKind -- @LiveUpdateEvent@+    | LiveUpdateKind -- @LiveUpdate@+    deriving stock ( Eq )++instance FromJSON RedditKind where+    parseJSON = withText "RedditKind" $ \case+        "t1" -> pure CommentKind+        "t2" -> pure AccountKind+        "t3" -> pure SubmissionKind+        "t4" -> pure MessageKind+        "t5" -> pure SubredditKind+        "t6" -> pure AwardKind+        "Listing" -> pure ListingKind+        "UserList" -> pure UserListKind+        "KarmaList" -> pure KarmaListKind+        "TrophyList" -> pure TrophyListKind+        "more" -> pure MoreKind+        "rb" -> pure RelKind+        "subreddit_settings" -> pure SubredditSettingsKind+        "stylesheet" -> pure StylesheetKind+        "wikipage" -> pure WikiPageKind+        "wikipagelisting" -> pure WikiPageListingKind+        "wikipagesettings" -> pure WikiPageSettingsKind+        "LabeledMulti" -> pure LabeledMultiKind+        "modaction" -> pure ModActionKind+        "LiveUpdateEvent" -> pure LiveThreadKind+        "LiveUpdate" -> pure LiveUpdateKind+        _ -> mempty++-- | \"Thing\"s are the base class of Reddit's OOP model. Each thing has several+-- properties, but here we are only interested in one, the \"fullname\". This+-- is a combination of a thing's type (here represented as a 'RedditKind'), and its+-- unique ID+class Thing a where+    -- | A @fullname@ is an identifier with a \"type prefix\" attached. See 'RedditKind'+    -- for possible prefixes. This prefixed form is required in various places by+    -- the Reddit API+    fullname :: a -> Text++instance (Foldable t, Thing a) => Thing (t a) where+    fullname ts = T.intercalate "," (fullname <$> F.toList ts)++-- | Certain API endpoints are @listings@, which can be paginated and filtered+-- using a 'Paginator'+data Listing t a = Listing+    { -- | Anchor of previous slice+      before   :: Maybe t+      -- | Anchor of next slice+    , after    :: Maybe t+      -- | The actual items returned in the response+    , children :: Seq a+    }+    deriving stock ( Show, Eq, Generic )++instance Ord t => Semigroup (Listing t a) where+    (Listing lb la lcs) <> (Listing rb ra rcs) =+        Listing (max lb rb) (min la ra) (lcs <> rcs)++instance Ord t => Monoid (Listing t a) where+    mappend = (<>)++    mempty = Listing Nothing Nothing mempty++instance (FromJSON a, FromJSON t) => FromJSON (Listing t a) where+    parseJSON = withKind ListingKind "Listing" $ \o ->+        Listing <$> o .:? "before" <*> o .:? "after" <*> o .: "children"++-- | Represents requests that can take additional options in a 'Paginator'. This+-- can be used to filter\/sort 'Listing' endpoints+class Paginable a where+    type PaginateOptions (a :: Type)++    type PaginateThing (a :: Type)++    -- | Default 'PaginateOptions' for this type+    defaultOpts :: PaginateOptions a++    -- | Get the fullname of the 'Thing' type associated with this type, if+    -- any+    getFullname :: a -> PaginateThing a+    default getFullname :: (PaginateThing a ~ Text) => a -> PaginateThing a+    getFullname _ = mempty++    -- | Convert the 'PaginateOptions' options to a 'Form'+    optsToForm :: PaginateOptions a -> Form+    default optsToForm+        :: ToForm (PaginateOptions a) => PaginateOptions a -> Form+    optsToForm = toForm++-- | This represents the protocol that Reddit uses to control paginating and+-- filtering entries. These can be applied to 'Listing' endpoints. The first+-- four fields below are common parameters that are applied to each 'Listing'.+-- The @opts@ field takes extended 'PaginateOptions' based on the second type+-- parameter+data Paginator t a = Paginator+    { -- | The pagination controls. These should be 'Thing' instances, in order+      -- to provide the 'fullname' params that Reddit requires+      before   :: Maybe t+    , after    :: Maybe t+      -- | The maximum number of items to return in an individual slice. Defaults+      -- to 25, with a maximum of 100+    , limit    :: Word+      -- | A control to disable filtering, e.g. hiding links that one has voted+      -- on. At the moment, turning this option on is a no-op+    , showAll  :: Bool+      -- | Whether or not to expand subreddits+    , srDetail :: Bool+      -- | Additional options, depending on the type parameter @a@+    , opts     :: PaginateOptions a+    }+    deriving stock ( Generic )++type role Paginator nominal nominal++deriving stock instance (Show t, Show (PaginateOptions a))+    => Show (Paginator t a)++deriving stock instance (Eq t, Eq (PaginateOptions a)) => Eq (Paginator t a)++instance (Thing t, Paginable a) => ToForm (Paginator t a) where+    toForm Paginator { .. } = commonOpts <> optsToForm @a opts+      where+        commonOpts = mkTextForm+            $ [ ("limit", tshow limit) ]+            <> catMaybes [ ("show", ) <$> bool Nothing (Just "given") showAll+                         , asum [ ("after", ) . fullname <$> after+                                , ("before", ) . fullname <$> before+                                ]+                         ]++instance {-# OVERLAPPING #-}( GL.HasField' name (Paginator t a) s+                            , a ~ b+                            , s ~ u+                            )+    => GL.HasField name (Paginator t a) (Paginator t b) s u where+    field = GL.field' @name++-- | This exists to derive case-insensitive 'Eq' instances for types that are+-- isomorphic to 'Text'+newtype CIText a = CIText a++instance Coercible a Text => Eq (CIText a) where+    (==) = (==) `on` T.toCaseFold . coerce++type family HKD f a where+    HKD Identity a = a+    HKD f a = f a++-- | Options that can be applied to comments or submissions, as represented by the+-- phantom type parameter+data ItemOpts a = ItemOpts+    { itemSort :: Maybe ItemSort+    , itemType :: Maybe ItemType+    , itemTime :: Maybe Time+      -- According to the API docs, the requested context should be between 0 and+      -- 8 or between 2 and 10, depending on the item being requested+    , context  :: Maybe Word+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm (ItemOpts a) where+    toForm ItemOpts { .. } = fromList+        $ catMaybes [ ("sort", ) . toQueryParam <$> itemSort+                    , ("type", ) . toQueryParam <$> itemType+                    , ("t", ) . toQueryParam <$> itemTime+                    , ("context", ) . toQueryParam <$> context+                    ]++-- | Defaults for fetching items, like comments or submissions+defaultItemOpts :: ItemOpts a+defaultItemOpts = ItemOpts+    { itemSort = Nothing+    , itemType = Nothing+    , itemTime = Nothing+    , context  = Nothing+    }++-- | How to sort items in certain 'Listing's. Not every option is guaranteed to+-- be accepted by a given endpoint+data ItemSort+    = Hot+    | New+    | Top+    | Controversial+    | Old+    | Random+    | QA+    | Live+    | Confidence+    deriving stock ( Show, Eq, Generic )++instance FromJSON ItemSort where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = fmap toLower }++instance ToJSON ItemSort where+    toJSON = genericToJSON --+        defaultOptions { constructorTagModifier = fmap toLower }++instance ToHttpApiData ItemSort where+    toQueryParam = showTextData++-- | Type of comments, for filtering in 'Listing's+data ItemType+    = Comments+    | Submissions+    deriving stock ( Show, Eq, Generic )++-- | A user- or moderator-generated report on a submission+data ItemReport = ItemReport+    { -- | The textual report reason\/description+      reason :: Text+    , count  :: Word+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ItemReport where+    -- Reports are sent as variable-length, heterogeneous arrays+    parseJSON = withArray "ItemReport" $ \a -> case toList a of+        report : count : _ ->+            ItemReport <$> parseJSON report <*> parseJSON count+        _                  -> mempty++instance ToHttpApiData ItemType where+    toQueryParam = \case+        Comments    -> "comments"+        Submissions -> "links"++-- | Sigils that a moderator can add to distinguish comments or submissions. Note+-- that the 'Admin' and 'Special' distinctions require special privileges to use+data Distinction+    = Moderator -- ^ Adds \"[M]\"+    | Undistinguished -- ^ Removes an existing distinction when sent+    | Admin -- ^ Adds \"[A]\"+    | Special -- ^ User-specific distinction+    deriving stock ( Show, Eq, Generic )++instance FromJSON Distinction where+    parseJSON = withText "Distinction" $ \case+        "moderator" -> pure Moderator+        "admin"     -> pure Admin+        "special"   -> pure Special+        _           -> mempty++instance ToHttpApiData Distinction where+    toQueryParam = \case+        Moderator       -> "yes"+        Undistinguished -> "no"+        d               -> showTextData d++-- | Time range when fetching comments or submissions+data Time+    = Hour+    | Day+    | Week+    | Month+    | Year+    | AllTime+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData Time where+    toQueryParam = \case+        AllTime -> "all"+        t       -> showTextData t++-- | A URL pointing to a resource hosted by Reddit. These should only be obtained+-- by parsing the JSON of existing resources or through particular actions that+-- perform the upload transaction and return the URL, e.g.+-- 'Network.Reddit.Moderation.uploadWidgetImage'+newtype UploadURL = UploadURL URL+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON, ToJSON, ToHttpApiData )++-- | Type synonym for URLs+type URL = Text++-- | Type synonym for bodies of submissions, comments, messages, etc...+type Body = Text++-- | Type synonym for titles of submissions, etc...+type Title = Text++-- | Type synonym for subjects of messages, etc...+type Subject = Text++-- | Type synonym RGB color strings+type RGBText = Text++-- | Type synonym for names of items+type Name = Text++-- | Type synonym for domains+type Domain = Text++-- | Type synonym for @fieldLabelModifier@s in @FromJSON@ instances+type Modifier = [Char] -> [Char]++-- | Type synonym the raw body of an HTTP response+type RawBody m = ConduitM () ByteString m ()++--Exceptions-------------------------------------------------------------------+-- | Base exception type for Reddit API client+data RedditException = forall e. Exception e => RedditException e++instance Show RedditException where+    show (RedditException e) = show e++instance Exception RedditException++-- | Exceptions generated within the Reddit API client+data ClientException+    = InvalidRequest Text+    | InvalidResponse Text+    | MalformedCredentials Text+    | OtherError Text+    | ConfigurationError Text+    deriving stock ( Eq, Show, Generic )++instance Exception ClientException where+    toException = redditExToException++    fromException = redditExFromException++-- | Exceptions returned from API endpoints+data APIException+    = ErrorWithStatus StatusMessage+    | ErrorWithMessage ErrorMessage+    | InvalidCredentials OAauthError+    | InvalidJSON JSONError+      -- ^ Sent if errors occur when posting JSON+    | JSONParseError Text LB.ByteString+      -- ^ With the response body, for further debugging+    | Redirected (Maybe Request)+      -- ^ If the API action should not allow automatic redirects,+      -- this error returns the possible redirected request+    | WebsocketError Text SomeException+      -- ^ Thrown when exceptions occur during websocket handling+    | UploadFailed+      -- ^ When an error occurs uploading media to Reddit\'s servers+    deriving stock ( Show, Generic )++instance Exception APIException where+    toException = redditExToException++    fromException = redditExFromException++instance FromJSON APIException where+    parseJSON = withObject "APIException" $ \(Object -> o) ->+        asum [ ErrorWithStatus <$> parseJSON o+             , ErrorWithMessage <$> parseJSON o+             , InvalidJSON <$> parseJSON o+             , InvalidCredentials <$> parseJSON o+             ]++-- | An error which occurs when attempting to authenticate via OAuth+data OAauthError = OAauthError+    { -- | The type of the error, e.g. \"invalid_grant\"+      errorType   :: Text+      -- | This field may be absent. If it exists, it describes+      -- the error+    , description :: Maybe Text+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON OAauthError where+    parseJSON = withObject "OAauthError"+        $ \o -> OAauthError <$> o .: "error" <*> o .:? "error_description"++-- | A specific error message+data ErrorMessage+    = EmptyError+    | OtherErrorMessage [Value]+    | Ratelimited Integer Text+    | CommentDeleted+    | BadSRName+    | SubredditNotExists+    | SubredditRequired+    | AlreadySubmitted+    | NoURL+    | NoName+    | NoText+    | TooShort+    | BadCaptcha+    | UserRequired+    deriving stock ( Show, Eq, Generic )++instance FromJSON ErrorMessage where+    parseJSON = withObject "ErrorMessage" $ \o ->+        msgP o =<< (.: "errors") =<< (o .: "json")+      where+        msgP o = withArray "[[Value]]" $ \a -> case toList a of+            v : _ -> msgsP v+            []    -> pure EmptyError+          where+            msgsP = withArray "[Value]" $ \a -> case toList a of+                "RATELIMIT" : String msg : _ -> Ratelimited+                    <$> fmap (round @Double)+                             ((.: "ratelimit") =<< o .: "json")+                    <*> pure msg+                "COMMENT_DELETED" : _ -> pure CommentDeleted+                "BAD_SR_NAME" : _ -> pure BadSRName+                "SUBREDDIT_REQUIRED" : _ -> pure SubredditRequired+                "SUBREDDIT_NOEXIST" : _ -> pure SubredditNotExists+                "ALREADY_SUB" : _ -> pure AlreadySubmitted+                "NO_URL " : _ -> pure NoURL+                "NO_TEXT" : _ -> pure NoText+                "NO_NAME" : _ -> pure NoName+                "BAD_CAPTCHA" : _ -> pure BadCaptcha+                "TOO_SHORT" : _ -> pure TooShort+                "USER_REQUIRED" : _ -> pure UserRequired+                v -> pure $ OtherErrorMessage v++-- | Type synonym for status codes in responses+type StatusCode = Int++-- | Details about a non-200 HTTP response+data StatusMessage =+    StatusMessage { statusCode :: StatusCode, message :: Text }+    deriving stock ( Eq, Show, Generic )++instance FromJSON StatusMessage where+    parseJSON = withObject "StatusMessage" $ \o ->+        StatusMessage <$> (o .: "error") <*> (o .: "message")++-- | Details about a non-200 response when posting JSON+data JSONError = JSONError+    { -- | The fields of the object containing errors+      fields      :: [Text]+    , explanation :: Text+    , message     :: Text+    , reason      :: Text+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON JSONError++redditExToException :: Exception e => e -> SomeException+redditExToException = toException . RedditException++redditExFromException :: Exception e => SomeException -> Maybe e+redditExFromException x = do+    RedditException a <- fromException x+    cast a++--Utilities--------------------------------------------------------------------+-- | 'Show' a 'ByteString'+bshow :: Show a => a -> ByteString+bshow = C8.pack . show++-- | 'Show' some 'Text'+tshow :: Show a => a -> Text+tshow = T.pack . show++-- | Drop the leading textual representation of a 'RedditKind' from a Reddit identifier,+-- or return the entire identifier if there is no prefix+dropTypePrefix :: RedditKind -> Text -> Parser Text+dropTypePrefix ty txt = case T.breakOn "_" txt of+    (prefix, ident)+        | prefix == textKind ty -> maybe mempty (pure . snd) (T.uncons ident)+    (ident, "")     -> pure ident+    _               -> mempty++-- | Opposite of 'dropTypePrefix': joins the textual representation of a 'RedditKind'+-- to an identifier with an underscore+prependType :: RedditKind -> Text -> Text+prependType ty txt = textKind ty <> "_" <> txt++-- | Convert an 'Integer' to 'UTCTime'+integerToUTC :: Integer -> UTCTime+integerToUTC = posixSecondsToUTCTime . fromInteger++-- | Ensures that the @kind@ field of a JSON object corresponds to the+-- expected 'RedditKind' of the response and runs a parsing function on its+-- @data@ field+withKind :: FromJSON b+         => RedditKind+         -> [Char]+         -> (b -> Parser a)+         -> Value+         -> Parser a+withKind ty name f = withObject name $ \o -> do+    guard . (ty ==) =<< o .: "kind"+    f =<< o .: "data"++-- | Like 'withKind', but can be used in the exceptional circumstances that a+-- container of values have heterogeneous kinds+withKinds :: FromJSON b+          => [RedditKind]+          -> [Char]+          -> (b -> Parser a)+          -> Value+          -> Parser a+withKinds tys name f = withObject name $ \o -> do+    guard . (`elem` tys) =<< o .: "kind"+    f =<< o .: "data"++-- | Convert a 'RedditKind' to its textual representation+textKind :: RedditKind -> Text+textKind = \case+    CommentKind           -> "t1"+    AccountKind           -> "t2"+    SubmissionKind        -> "t3"+    MessageKind           -> "t4"+    SubredditKind         -> "t5"+    AwardKind             -> "t6"+    ListingKind           -> "Listing"+    UserListKind          -> "UserList"+    KarmaListKind         -> "KarmaList"+    TrophyListKind        -> "TrophyList"+    MoreKind              -> "more"+    RelKind               -> "rb"+    SubredditSettingsKind -> "subreddit_settings"+    StylesheetKind        -> "stylesheet"+    WikiPageKind          -> "wikipage"+    WikiPageListingKind   -> "wikipagelisting"+    WikiPageSettingsKind  -> "wikipagesettings"+    LabeledMultiKind      -> "LabeledMulti"+    ModActionKind         -> "modaction"+    LiveThreadKind        -> "LiveUpdateEvent"+    LiveUpdateKind        -> "LiveUpdate"++-- | Parse the @edited@ field in comments or submissions, which can either be+-- @false@ or a Unix timestamp+editedP :: Value -> Parser (Maybe UTCTime)+editedP (Bool _)   = pure Nothing+editedP (Number n) =+    pure $ integerToUTC . toInteger <$> toBoundedInteger @Int n+editedP _          = mempty++-- | Verify that some name corresponds to specifiable Reddit naming rules+validateName :: (MonadThrow m, Coercible a Text)+             => Maybe [Char]+             -> Maybe (Int, Int)+             -> Text+             -> Text+             -> m a+validateName specialChars range name txt+    | inRange (fromMaybe (3, 20) range) (T.length txt) --+        , T.all (`elem` allowedChars) txt --+        = pure $ coerce txt+    | otherwise = throwM . OtherError+        $ mconcat [ name <> " may only consist of alphanumeric "+                  , "characters, hyphens, and underscores, and must be "+                  , "between 3 and 20 characters long"+                  ]+  where+    allowedChars = mconcat [ [ 'a' .. 'z' ]+                           , [ 'A' .. 'Z' ]+                           , [ '0' .. '9' ]+                           , fromMaybe [ '_', '-' ] specialChars+                           ]++-- | Make a comma-separated sequence of query params+joinParams :: (Foldable t, ToHttpApiData a) => t a -> Text+joinParams = T.intercalate "," . fmap toQueryParam . F.toList++-- | Return @Nothing@ if a text field is empty+nothingTxtNull :: FromJSON a => Text -> Parser (Maybe a)+nothingTxtNull = \case+    t+        | T.null t -> pure Nothing+        | otherwise -> Just <$> parseJSON (String t)++-- | Encode a list of 'Pair's to strict 'Text'+textObject :: [Pair] -> Text+textObject = textEncode . object++-- | Encode a 'ToJSON' instance to strict 'Text'+textEncode :: ToJSON a => a -> Text+textEncode = LT.toStrict . encodeToLazyText++-- | Split a JSON identifier on \"_\"; if it matches the given type+-- prefix, returning the remaining text. Otherwise, return the+-- identifier whole if there is no remaining text+breakOnType :: (Coercible a Text) => Text -> Text -> Parser a+breakOnType ty t = case T.breakOn "_" t of+    (prefix, r)+        | prefix == ty -> maybe mempty (pure . coerce . snd) (T.uncons r)+        | T.null r -> pure $ coerce prefix+        | otherwise -> mempty++-- | Get all of the values from a 'HashMap' and place them in a 'Seq', discarding+-- the keys+getVals :: FromJSON b => HashMap Text Value -> Parser (Seq b)+getVals = fmap fromList . traverse (parseJSON . snd) . HM.toList++-- | Make a form from @[(Text, Text)]@ pairs+mkTextForm :: [(Text, Text)] -> Form+mkTextForm = toForm @[(Text, Text)]
+ src/Network/Reddit/Types/Item.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Item+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Item+    ( Item(..)+    , ItemID(..)+    , PostedItem+    , Vote(..)+    , Report+    , mkReport+    ) where++import           Control.Monad.Catch             ( MonadThrow(throwM) )++import           Data.Aeson+                 ( (.:)+                 , FromJSON(..)+                 , Options(sumEncoding)+                 , SumEncoding(UntaggedValue)+                 , Value(Object)+                 , defaultOptions+                 , genericParseJSON+                 , withObject+                 )+import           Data.Text                       ( Text )+import qualified Data.Text                       as T++import           GHC.Generics                    ( Generic )++import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Submission++import           Web.HttpApiData                 ( ToHttpApiData )++-- | Wraps either a 'CommentID' or a 'SubmissionID'. This is required to use+-- 'Item's with 'Paginator's+data ItemID+    = CommentItemID CommentID+    | SubmissionItemID SubmissionID+    deriving stock ( Show, Eq, Generic )++instance Thing ItemID where+    fullname (CommentItemID cid)    = fullname cid+    fullname (SubmissionItemID sid) = fullname sid++instance FromJSON ItemID where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++-- | Certain endpoints will return either 'Comment's or a 'Submission's, or both+data Item+    = CommentItem Comment+    | SubmissionItem Submission+    deriving stock ( Show, Eq, Generic )++instance Paginable Item where+    type PaginateOptions Item = ItemOpts Item++    type PaginateThing Item = ItemID++    defaultOpts = defaultItemOpts++    getFullname = \case+        CommentItem Comment { commentID }          -> CommentItemID commentID+        SubmissionItem Submission { submissionID } ->+            SubmissionItemID submissionID++instance FromJSON Item where+    parseJSON = withObject "Item" $ \o -> o .: "kind" >>= \case+        x+            | x == CommentKind -> CommentItem <$> parseJSON (Object o)+            | x == SubmissionKind -> SubmissionItem <$> parseJSON (Object o)+            | otherwise -> mempty++-- | Wrapper for parsing new 'Item's, 'Comment's, or 'Submission's that are returned+-- after requesting their creation+newtype PostedItem a = PostedItem a+    deriving stock ( Show, Generic )++deriving newtype instance Eq a => Eq (PostedItem a)++instance FromJSON (PostedItem Comment) where+    parseJSON = withObject "PostedItem Comment" $ \o -> postedCommentP+        =<< ((.: "things") =<< (.: "data") =<< o .: "json")+      where+        postedCommentP [ Object o ] = PostedItem+            <$> (commentP =<< o .: "data")+        postedCommentP _            = mempty++instance FromJSON (PostedItem Submission) where+    parseJSON = withObject "PostedItem Submission" $ \o -> postedSubmissionP+        =<< ((.: "things") =<< (.: "data") =<< o .: "json")+      where+        postedSubmissionP [ Object o ] = PostedItem+            <$> (submissionP =<< o .: "data")+        postedSubmissionP _            = mempty++instance FromJSON (PostedItem Item) where+    parseJSON = withObject "PostedItem Item" $ \o -> postedItemP+        =<< ((.: "things") =<< (.: "data") =<< o .: "json")+      where+        postedItemP [ Object o ] = (o .: "kind") >>= \case+            k+                | k == CommentKind -> PostedItem . CommentItem+                    <$> (commentP =<< o .: "data")+                | k == SubmissionKind -> PostedItem . SubmissionItem+                    <$> (submissionP =<< o .: "data")+                | otherwise -> mempty+        postedItemP _            = mempty++-- | The direction in which to vote+data Vote+    = Downvote+    | Unvote+    | Upvote+    deriving stock ( Show, Eq, Generic, Ord )++-- | The reason for issuing a report. The length of the contained text must be <=+-- 100 characters+newtype Report = Report Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++-- | Smart constructor for 'Report's, which may be no longer than 100 characters+-- in length+mkReport :: MonadThrow m => Text -> m Report+mkReport txt+    | T.length txt > 100 =+        throwM $ OtherError "mkReport: length must not exceed 100 characters"+    | otherwise = pure $ Report txt
+ src/Network/Reddit/Types/Live.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Live+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Live+    ( LiveThread(..)+    , LiveThreadID(LiveThreadID)+    , PostableLiveThread(..)+    , NewLiveThread+    , UpdatedLiveThread+    , liveThreadToPostable+    , mkNewLiveThread+    , PostedLiveThread+    , LiveUpdate(..)+    , LiveUpdateID(LiveUpdateID)+    , LiveUpdateEmbed(..)+    , LiveContributor(..)+    , LiveContributorList(..)+    , LivePermission(..)+    , LiveReportType(..)+    , LiveState(..)+    ) where++import           Control.Monad                 ( (<=<) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(parseJSON)+                 , Options(constructorTagModifier)+                 , Value(Object)+                 , defaultOptions+                 , genericParseJSON+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Char                     ( toLower )+import           Data.Coerce                   ( coerce )+import           Data.Foldable                 ( asum )+import           Data.Maybe                    ( fromMaybe )+import           Data.Sequence                 ( Seq )+import           Data.Text                     ( Text )+import           Data.Time                     ( UTCTime )++import           GHC.Exts                      ( IsList(..) )+import           GHC.Generics                  ( Generic )++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Internal++import           Web.FormUrlEncoded            ( ToForm(toForm) )+import           Web.HttpApiData               ( ToHttpApiData(..)+                                               , showTextData+                                               )++-- | An existing Reddit live thread. It may be currently live or already+-- complete+data LiveThread = LiveThread+    { liveThreadID    :: LiveThreadID+    , title           :: Title+    , description     :: Maybe Body+    , descriptionHTML :: Maybe Body+    , resources       :: Maybe Body+    , resourcesHTML   :: Maybe Body+    , created         :: UTCTime+      -- | The current number of viewers; will be @Nothing@ if the+      -- @liveState@ is 'Complete'+    , viewerCount     :: Maybe Integer+    , liveState       :: LiveState+    , nsfw            :: Bool+      -- | If the thread is still live, this will allow you to connect to+      -- a websocket server to receive live updates as the thread progresses+    , websocketURL    :: Maybe URL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON LiveThread where+    parseJSON = withKind LiveThreadKind "LiveThread" $ \o -> LiveThread+        <$> o .: "id"+        <*> o .: "title"+        <*> (nothingTxtNull =<< o .: "description")+        <*> (nothingTxtNull =<< o .: "description_html")+        <*> (nothingTxtNull =<< o .: "resources")+        <*> (nothingTxtNull =<< o .: "resources_html")+        <*> (integerToUTC <$> o .: "created_utc")+        <*> o .: "viewer_count"+        <*> o .: "state"+        <*> o .: "nsfw"+        <*> o .:? "websocket_url"++-- The endpoints that list @LiveThread@s are a @Listing@, but there are no+-- additional options that can be passed to them. This dummy instance at least+-- allows using a @Listing ... LiveThread@ with existing convenience actions+instance Paginable LiveThread where+    type PaginateOptions LiveThread = ()++    type PaginateThing LiveThread = LiveThreadID++    defaultOpts = ()++    optsToForm _ = mempty++    getFullname LiveThread { liveThreadID } = liveThreadID++-- | ID for a single 'LiveThread'+newtype LiveThreadID = LiveThreadID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++instance FromJSON LiveThreadID where+    parseJSON =+        withText "LiveThreadID" (coerce . dropTypePrefix LiveThreadKind)++instance Thing LiveThreadID where+    fullname (LiveThreadID ltid) = prependType LiveThreadKind ltid++-- | The state of the 'LiveThread'+data LiveState+    = Current+    | Complete+    deriving stock ( Show, Eq, Generic )++instance FromJSON LiveState where+    parseJSON = withText "LiveState" $ \case+        "live"     -> pure Current+        "complete" -> pure Complete+        _          -> mempty++-- | Data to create a new 'LiveThread' or update an existing one. In the latter+-- case, see 'liveThreadToPostable' for conversion+data PostableLiveThread = PostableLiveThread+    { title       :: Title+      -- | Markdown-formatted; if @Nothing@, defaults to an empty string+    , description :: Maybe Body+      -- | Markdown-formatted; if @Nothing@, defaults to an empty string+    , resources   :: Maybe Body+    , nsfw        :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm PostableLiveThread where+    toForm PostableLiveThread { .. } =+        fromList [ ("title", title)+                 , ("description", fromMaybe mempty description)+                 , ("resources", fromMaybe mempty description)+                 , ("nsfw", toQueryParam nsfw)+                 , ("api_type", "json")+                 ]++-- | Type synonym for creating new live threads+type NewLiveThread = PostableLiveThread++-- | Type synonym for updating existing live threads+type UpdatedLiveThread = PostableLiveThread++-- | Create a 'NewLiveThread' with default values for most fields+mkNewLiveThread :: Title -> NewLiveThread+mkNewLiveThread title = PostableLiveThread+    { title+    , description = Nothing+    , resources   = Nothing  --+    , nsfw        = False+    }++-- | Convenience function to transform an existing 'LiveThread' into+-- a 'PostableLiveThread', which may be used in updates+liveThreadToPostable :: LiveThread -> UpdatedLiveThread+liveThreadToPostable LiveThread { .. } = PostableLiveThread { .. }++-- | Wrapper for parsing the ID returned from POSTing a livethred+newtype PostedLiveThread = PostedLiveThread LiveThreadID+    deriving stock ( Show, Generic )++instance FromJSON PostedLiveThread where+    parseJSON = withObject "PostedLiveThread"+        $ fmap PostedLiveThread . ((.: "id") <=< (.: "data") <=< (.: "json"))++-- | An individual update in a 'LiveThread'+data LiveUpdate = LiveUpdate+    { liveUpdateID :: LiveUpdateID+    , author       :: Maybe Username+    , body         :: Body+    , bodyHTML     :: Body+    , stricken     :: Bool+    , embeds       :: Seq LiveUpdateEmbed+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON LiveUpdate where+    parseJSON = withKind LiveUpdateKind "LiveUpdate" $ \o -> LiveUpdate+        <$> o .: "name"+        <*> o .: "author"+        <*> o .: "body"+        <*> o .: "body_html"+        <*> o .: "stricken"+        <*> o .: "embeds"++-- The endpoints that list @LiveUpdate@s are a @Listing@, but there are no+-- additional options that can be passed to them. This dummy instance at least+-- allows using a @Listing ... LiveUpdate@ with existing convenience actions+instance Paginable LiveUpdate where+    type PaginateOptions LiveUpdate = ()++    type PaginateThing LiveUpdate = LiveUpdateID++    defaultOpts = ()++    optsToForm _ = mempty++    getFullname LiveUpdate { liveUpdateID } = liveUpdateID++-- | ID for a 'LiveUpdate'+newtype LiveUpdateID = LiveUpdateID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++instance Thing LiveUpdateID where+    fullname (LiveUpdateID lid) = prependType LiveUpdateKind lid++instance FromJSON LiveUpdateID where+    parseJSON =+        withText "LiveUpdateID" (coerce . dropTypePrefix LiveUpdateKind)++-- | External resources embedded in a 'LiveUpdate'+data LiveUpdateEmbed = LiveUpdateEmbed+    { -- | URL pointing to a Reddit-external resource+      url    :: URL+    , height :: Maybe Integer+    , width  :: Maybe Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON LiveUpdateEmbed++-- | A user contributor in a 'LiveThread'+data LiveContributor = LiveContributor+    { userID      :: UserID+    , username    :: Username+    , permissions :: Seq LivePermission+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON LiveContributor where+    parseJSON = withObject "LiveContributor" $ \o -> LiveContributor+        <$> o .: "id"+        <*> o .: "name"+        <*> (permissionsP =<< o .: "permissions")+      where+        permissionsP = withArray "[LivePermission]" $ \a -> case toList a of+            [ "all" ] -> pure $ fromList [ Edit .. Manage ]+            xs        -> fromList <$> traverse parseJSON xs++-- | Wrapper to parse lists of 'LiveContributor's+newtype LiveContributorList = LiveContributorList (Seq LiveContributor)+    deriving stock ( Show, Generic )++instance FromJSON LiveContributorList where+    -- Depending on the number of contributors, the actual type of the returned+    -- JSON changes+    parseJSON v = asum [ contribArray v, contribObject v ]+      where+        contribArray  =+            withArray "[LiveContributorList]" $ \a -> case toList a of+                o@(Object _) : _ -> contribObject o+                _                -> mempty++        contribObject = withKind UserListKind "LiveContributorList"+            $ fmap (LiveContributorList . fromList)+            . (contribListP <=< (.: "children"))++        contribListP  =+            withArray "[LiveContributor]" (traverse parseJSON . toList)++-- | Permission granted to a 'LiveContributor'+data LivePermission+    = Edit+    | Update+    | Manage+    | Settings+    deriving stock ( Show, Eq, Generic, Ord, Enum, Bounded )++instance FromJSON LivePermission where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = fmap toLower }++instance ToHttpApiData LivePermission where+    toQueryParam = showTextData++-- | The reason for reporting the 'LiveThread' to the Reddit admins+data LiveReportType+    = Spam+    | VoteManipulation+    | PersonalInfo+    | Sexualizing+    | SiteBreaking+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData LiveReportType where+    toQueryParam = \case+        Spam             -> "spam"+        VoteManipulation -> "vote-manipulation"+        PersonalInfo     -> "personal-info"+        Sexualizing      -> "sexualizing-minors"+        SiteBreaking     -> "site-breaking"
+ src/Network/Reddit/Types/Message.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Message+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Message+    ( Message(..)+    , PrivateMessageID(PrivateMessageID)+    , MessageID(..)+    , MessageOpts(..)+    , NewMessage(..)+    , PostedMessage+    ) where++import           Data.Aeson+                 ( (.:)+                 , FromJSON(..)+                 , Object+                 , Options(sumEncoding)+                 , SumEncoding(UntaggedValue)+                 , Value(..)+                 , defaultOptions+                 , genericParseJSON+                 , withObject+                 , withText+                 )+import           Data.Aeson.Types              ( Parser )+import           Data.Coerce                   ( coerce )+import           Data.Generics.Product         ( HasField(field) )+import           Data.Sequence                 ( Seq )+import           Data.Text                     ( Text )+import           Data.Time                     ( UTCTime )++import           GHC.Exts                      ( IsList(fromList) )+import           GHC.Generics                  ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Comment  ( CommentID )+import           Network.Reddit.Types.Internal++import           Web.FormUrlEncoded            ( ToForm(..) )+import           Web.HttpApiData               ( ToHttpApiData(toQueryParam) )++-- | A private message or comment reply+data Message = Message+    { messageID :: MessageID+    , author    :: Username+    , dest      :: Username+    , body      :: Body+    , bodyHTML  :: Body+    , subject   :: Subject+    , created   :: UTCTime+    , new       :: Bool+    , replies   :: Seq Message+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Message where+    parseJSON = withKinds [ MessageKind, CommentKind ] "Message" messageP++messageP :: Object -> Parser Message+messageP o = Message <$> (o .: "name")+    <*> (o .: "author")+    <*> (o .: "dest")+    <*> (o .: "body")+    <*> (o .: "body_html")+    <*> (o .: "subject")+    <*> (integerToUTC <$> o .: "created")+    <*> (o .: "new")+    <*> (repliesP =<< o .: "replies")+  where+    repliesP (String _)   = pure mempty+    repliesP v@(Object _) = parseJSON @(Listing MessageID Message) v+        <&> (^. field @"children")+    repliesP _            = mempty++instance Paginable Message where+    type PaginateOptions Message = MessageOpts++    type PaginateThing Message = MessageID++    defaultOpts = MessageOpts { mark = False }++    getFullname Message { messageID } = messageID++-- | Options for requesting and paginating 'Listing's of 'Message's+data MessageOpts = MessageOpts+    { -- | If set to @False@ (the default), any new messages read via the API+      -- will maintain their unread status in the web UI+      mark :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm MessageOpts where+    toForm MessageOpts { .. } = fromList [ ("mark", toQueryParam mark) ]++-- | This can be 'CommentID' for replies to a comment, or a 'PrivateMessageID'+-- for private messages. Querying one's inbox or unread messages can provide+-- both types+data MessageID+    = CommentReply CommentID+    | PrivateMessage PrivateMessageID+    deriving stock ( Show, Eq, Generic, Ord )++instance FromJSON MessageID where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++instance ToHttpApiData MessageID where+    toQueryParam (CommentReply cid)   = toQueryParam cid+    toQueryParam (PrivateMessage mid) = toQueryParam mid++instance Thing MessageID where+    fullname (CommentReply cid)   = fullname cid+    fullname (PrivateMessage mid) = fullname mid++-- | A private message ID+newtype PrivateMessageID = PrivateMessageID Text+    deriving stock ( Show, Generic, Ord )+    deriving newtype ( Eq, ToHttpApiData )++instance FromJSON PrivateMessageID where+    parseJSON =+        withText "PrivateMessageID" (coerce . dropTypePrefix MessageKind)++instance Thing PrivateMessageID where+    fullname = prependType MessageKind . coerce++-- | For sending new 'Message's via the @compose@ API endpoint+data NewMessage = NewMessage+    { -- | The subject should be <= 100 characters in length+      subject :: Subject+    , message :: Body+    , dest    :: Username+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm NewMessage where+    toForm NewMessage { .. } =+        fromList [ ("to", toQueryParam dest)+                 , ("subject", subject)+                 , ("text", message)+                 ]++newtype PostedMessage = PostedMessage Message+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance FromJSON PostedMessage where+    parseJSON = withObject "PostedMessage" $ \o -> postedMessageP+        =<< ((.: "things") =<< (.: "data") =<< o .: "json")+      where+        postedMessageP [ Object o ] = PostedMessage+            <$> (messageP =<< o .: "data")+        postedMessageP _            = mempty
+ src/Network/Reddit/Types/Moderation.hs view
@@ -0,0 +1,1446 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Moderation+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Moderation+    ( -- * Item moderation+      ModItem(..)+    , ModItemOpts(..)+    , RemovalMessage(..)+    , RemovalType(..)+    , RemovalReason(..)+    , RemovalReasonID+    , NewRemovalReasonID+    , RemovalReasonList+      -- * Subreddit relationships+    , ModPermission(..)+    , SubredditRelationship(..)+    , RelID(RelID)+    , MuteID(MuteID)+    , ModInvitee(..)+    , ModInviteeList(..)+    , ModList+    , ModAccount(..)+    , RelInfo(..)+    , MuteInfo(..)+    , RelInfoOpts(..)+    , Ban(..)+    , BanNotes(..)+      -- * Subreddit settings+    , SubredditSettings(..)+    , CrowdControlLevel(..)+    , SubredditType(..)+    , SpamFilter(..)+    , Wikimode(..)+    , ContentOptions(..)+      -- * Modmail+    , Modmail(..)+    , ModmailConversation(..)+    , ModmailMessage(..)+    , ModmailID+    , BulkReadIDs+    , ModmailAuthor(..)+    , ModmailObjID(..)+    , ModmailState(..)+    , ModmailSort(..)+    , ModmailOpts(..)+    , defaultModmailOpts+    , ConversationDetails+    , ModmailReply(..)+    , mkModmailReply+    , NewConversation(..)+      -- * Modlog+    , ModAction(..)+    , ModActionID+    , ModActionType(..)+    , ModActionOpts(..)+      -- * Styles and images+    , Stylesheet(..)+    , SubredditImage(..)+    , S3ModerationLease(..)+    , StructuredStyleImage(..)+    , StyleImageAlignment(..)+      -- * Misc+    , TrafficStat(..)+    , Traffic(..)+    , LanguageCode(AF, AR, BE, BG, BS, CA, CS, CY, DA, DE, EL, EN, EO,+             ES, ET, EU, FA, FI, FR, GD, GL, HE, HI, HR, HU, HY, ID, IS, IT, JA,+             KO, LA, LT, LV, MS, NL, NN, NO, PL, PT, RO, RU, SK, SL, SR, SV, TA,+             TH, TR, UK, VI, ZH)+    ) where++import           Control.Applicative            ( Alternative((<|>))+                                                , optional+                                                )+import           Control.Monad                  ( (<=<), (>=>) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , FromJSONKey(..)+                 , JSONKeyOptions(..)+                 , KeyValue((.=))+                 , Options(..)+                 , Value(Object)+                 , defaultJSONKeyOptions+                 , defaultOptions+                 , genericFromJSONKey+                 , genericParseJSON+                 , withArray+                 , withObject+                 , withScientific+                 , withText+                 )+import           Data.Aeson.Casing              ( snakeCase )+import           Data.Aeson.Types               ( Parser )+import           Data.Char                      ( toLower )+import           Data.Coerce                    ( coerce )+import           Data.Foldable                  ( asum )+import qualified Data.HashMap.Strict            as HM+import           Data.HashMap.Strict            ( HashMap )+import           Data.Hashable                  ( Hashable )+import           Data.Maybe+                 ( catMaybes+                 , fromMaybe+                 , mapMaybe+                 , maybeToList+                 )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import           Data.Time                      ( UTCTime, zonedTimeToUTC )+import           Data.Time.Format.ISO8601       ( iso8601ParseM )++import           GHC.Exts                       ( IsList(fromList, toList) )+import           GHC.Generics                   ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Item+import           Network.Reddit.Types.Subreddit++import           Web.FormUrlEncoded+                 ( FormOptions(fieldLabelModifier)+                 , ToForm(..)+                 , defaultFormOptions+                 , genericToForm+                 )+import           Web.HttpApiData                ( ToHttpApiData(..)+                                                , showTextData+                                                )++--Item moderation--------------------------------------------------------------+-- | An 'Item' of interest to moderators (spam, modqueue, etc...)+newtype ModItem = ModItem Item+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON )++instance Paginable ModItem where+    type PaginateOptions ModItem = ModItemOpts++    type PaginateThing ModItem = ItemID++    defaultOpts = ModItemOpts { only = Nothing }++    getFullname (ModItem item) = getFullname item++-- | Options for 'Listing's of 'ModItem's. Only contains one field, @only@ to+-- constrain the request to a single type (i.e. comments or links)+data ModItemOpts = ModItemOpts { only :: Maybe ItemType }+    deriving stock ( Show, Eq, Generic )++instance ToForm ModItemOpts where+    toForm ModItemOpts { .. } = fromList+        $ foldMap pure (("only", ) . toQueryParam <$> only)++-- | A message to explain\/note the removal an 'Item'+data RemovalMessage = RemovalMessage+    { itemID      :: ItemID+    , message     :: Body+    , title       :: Title+    , removalType :: RemovalType+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm RemovalMessage where+    toForm RemovalMessage { .. } =+        fromList [ ( "model"+                   , textObject [ "item_id" .= [ fullname itemID ]+                                , "message" .= message+                                , "title" .= title+                                , "type" .= toQueryParam removalType+                                ]+                   )+                 ]++-- | Controls how the 'RemovalMessage' will be disseminated+data RemovalType+    = PublicComment -- ^ Leaves the message as a public comment+    | PrivateExposed -- ^ Leaves moderator note with exposed username+    | PrivateHidden -- ^ Leaves mod note with hidden username+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData RemovalType where+    toQueryParam = \case+        PublicComment  -> "public"+        PrivateExposed -> "private_exposed"+        PrivateHidden  -> "private"++-- | A subreddit-specific reason for item removal+data RemovalReason = RemovalReason+    { removalReasonID :: RemovalReasonID, message :: Body, title :: Title }+    deriving stock ( Show, Eq, Generic )++instance FromJSON RemovalReason where+    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "removalReasonID" -> "id"+            s                 -> s++instance ToForm RemovalReason where+    toForm RemovalReason { .. } =+        fromList [ ("title", title), ("message", message) ]++newtype RemovalReasonList = RemovalReasonList (Seq RemovalReason)+    deriving stock ( Show, Generic )++instance FromJSON RemovalReasonList where+    parseJSON = withObject "RemovalReasonList"+        $ fmap RemovalReasonList . (removalsP <=< (.: "data"))+      where+        removalsP = withObject "HashMap Text RemovalReason" getVals++-- | Identifier for a 'RemovalReason'+type RemovalReasonID = Text++newtype NewRemovalReasonID = NewRemovalReasonID RemovalReasonID+    deriving stock ( Show, Generic )++instance FromJSON NewRemovalReasonID where+    parseJSON = withObject "NewRemovalReasonID"+        $ fmap NewRemovalReasonID . (.: "id")++--Relationships----------------------------------------------------------------+-- | Various permissions that can be afforded to moderators and invitees+data ModPermission+    = Access+    | Flair+    | Mail+    | Configuration+    | ChatConfig+    | ChatOperator+    | Posts+    | Wiki+    deriving stock ( Show, Eq, Generic, Ord, Enum, Bounded )++instance ToHttpApiData ModPermission where+    toQueryParam = \case+        Configuration -> "config"+        ChatOperator  -> "chat_operator"+        ChatConfig    -> "chat_config"+        s             -> showTextData s++instance FromJSON ModPermission where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = modPermissionTagModifier }++instance FromJSONKey ModPermission where+    fromJSONKey = genericFromJSONKey --+        defaultJSONKeyOptions { keyModifier = modPermissionTagModifier }++modPermissionTagModifier :: [Char] -> [Char]+modPermissionTagModifier = \case+    tag+        | tag `elem` [ "ChatConfig", "ChatOperator" ] -> snakeCase tag+        | tag == "Configuration" -> "config"+        | otherwise -> toLower <$> tag++instance Hashable ModPermission++-- | The types of relationships that mods can manipulate+data SubredditRelationship+    = Mod+    | ModInvitation+    | Contributor+    | BannedFromWiki+    | WikiContributor+    | Banned+    | Muted+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData SubredditRelationship where+    toQueryParam = \case+        Mod             -> "moderator"+        ModInvitation   -> "moderator_invite"+        Contributor     -> "contributor"+        BannedFromWiki  -> "wikibanned"+        WikiContributor -> "wikicontributor"+        Banned          -> "banned"+        Muted           -> "muted"++    toUrlPiece = \case+        rel+            | rel `elem` [ Contributor, WikiContributor ] ->+                toQueryParam rel <> "s" -- these types are pluralized in+                                        -- get requests+            | otherwise -> toQueryParam rel++-- | Information about a user who has been invited to moderate the subreddit+data ModInvitee = ModInvitee+    { userID      :: UserID+    , username    :: Username+      -- | Flair text on this subreddit+    , flairText   :: Maybe FlairText+    , permissions :: HashMap ModPermission Bool+    , moddedAt    :: UTCTime+    , postKarma   :: Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModInvitee where+    parseJSON = withObject "ModInvitee" $ \o -> ModInvitee <$> o .: "id"+        <*> o .: "username"+        <*> o .:? "authorFlairText"+        <*> (handlePerms =<< o .: "modPermissions")+        <*> (integerToUTC <$> o .: "moddedAtUTC")+        <*> o .: "postKarma"+      where+        -- Reddit uses "all" as an permission, but this perm is not exposed+        -- as a constructor for @ModPermission@, as doing so would allow+        -- invalid states where @All@ is selected, but not all permissions+        -- are provided+        handlePerms = withObject "HashMap ModPermission Bool"+            $ \o -> parseJSON . Object $ HM.delete "all" o++-- | A list containing users invited to moderate the subreddit. For some reason,+-- the endpoints listing moderator invites do not use the same @Listing@ mechanism+-- that most other endpoints do+data ModInviteeList = ModInviteeList+    { -- | At most 25 of the invited moderators+      invited        :: Seq ModInvitee+      -- | If the list contains all invitees+    , allUsersLoaded :: Bool+      -- | Pagination controls for the next moderator invites+    , after          :: Maybe UserID+      -- | Pagination controls for the previous moderator invites+    , before         :: Maybe UserID+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModInviteeList where+    parseJSON = withObject "ModInviteeList" $ \o -> ModInviteeList+        <$> (getVals =<< o .: "moderators")+        <*> o .: "allUsersLoaded"+        <*> o .: "after"+        <*> o .: "before"++-- | This instance can be used to paginate through the listings, with a bias+-- towards @after@+instance ToForm ModInviteeList where+    toForm ModInviteeList { .. } = fromList . maybeToList+        $ asum [ ("after", ) . fullname <$> after+               , ("before", ) . fullname <$> before+               ]++-- | Account information about a moderator, similar to a 'Account', but+-- with less information+data ModAccount = ModAccount+    { username    :: Username+    , userID      :: UserID+    , relID       :: RelID+      -- | Flair text on the subreddit+    , flairText   :: Maybe FlairText+      -- | Flair CSS class on the subreddit+    , flairCSS    :: Maybe CSSClass+    , date        :: UTCTime+      -- | If @Nothing@, indicates the user has all mod permissions+    , permissions :: Maybe (Seq ModPermission)+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModAccount where+    parseJSON = withObject "ModAccount" $ \o -> ModAccount <$> o .: "name"+        <*> o .: "id"+        <*> o .: "rel_id"+        <*> o .: "author_flair_text"+        <*> o .: "author_flair_css_class"+        <*> (integerToUTC <$> o .: "date")+        <*> optional (o .: "mod_permissions")++-- | Wrapped for list of moderators, which resembles a 'Listing', but cannot be+-- paginated or filtered+newtype ModList = ModList (Seq ModAccount)+    deriving stock ( Show, Generic )++instance FromJSON ModList where+    parseJSON =+        withKind UserListKind "ModList" $ \o -> ModList <$> o .: "children"++-- | Information about a contributor on the subreddit+data RelInfo = RelInfo+    { userID   :: UserID+    , relID    :: RelID+    , username :: Username+    , date     :: UTCTime+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON RelInfo where+    parseJSON = withObject "RelInfo" $ \o -> RelInfo <$> o .: "id"+        <*> o .: "rel_id"+        <*> o .: "name"+        <*> (integerToUTC <$> o .: "date")++instance Paginable RelInfo where+    type PaginateOptions RelInfo = RelInfoOpts++    type PaginateThing RelInfo = RelID++    defaultOpts = RelInfoOpts { username = Nothing }++    getFullname RelInfo { relID } = relID++-- | Information about a muted user+data MuteInfo = MuteInfo+    { userID   :: UserID+    , muteID   :: MuteID+    , username :: Username+    , date     :: UTCTime+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON MuteInfo where+    parseJSON = withObject "MuteInfo" $ \o -> MuteInfo <$> o .: "id"+        <*> o .: "rel_id"+        <*> o .: "name"+        <*> (integerToUTC <$> o .: "date")++instance Paginable MuteInfo where+    type PaginateOptions MuteInfo = RelInfoOpts++    type PaginateThing MuteInfo = MuteID++    defaultOpts = RelInfoOpts { username = Nothing }++    getFullname MuteInfo { muteID } = muteID++-- | Options for 'Listing's of 'RelInfo'. Currently only takes a single+-- field, @user@, to limit the listing to a single user+data RelInfoOpts = RelInfoOpts { username :: Maybe Username }+    deriving stock ( Show, Eq, Generic )++instance ToForm RelInfoOpts where+    toForm RelInfoOpts { .. } = fromList+        $ foldMap pure (("user", ) . toQueryParam <$> username)++--Subreddit settings-----------------------------------------------------------+-- | The settings that may be configured for a particular subreddit+data SubredditSettings = SubredditSettings+    { subredditID             :: SubredditID+    , title                   :: Title+    , description             :: Body+      -- | The text that appears on the submission page+    , submitText              :: Text+      -- | Custom label for creating submissions+    , submitTextLabel         :: Text+      -- | The text seen when hovering over the snoo+    , headerHoverText         :: Text+    , language                :: LanguageCode+    , subredditType           :: SubredditType+    , contentOptions          :: ContentOptions+      -- | A hex string specifying the color theme on mobile+    , keyColor                :: RGBText+    , wikimode                :: Wikimode+    , wikiEditKarma           :: Integer+    , wikiEditAge             :: Integer+    , commentScoreHideMins    :: Integer+    , spamComments            :: SpamFilter+    , spamSelfposts           :: SpamFilter+    , spamLinks               :: SpamFilter+    , crowdControlLevel       :: CrowdControlLevel+    , crowdControlChatLevel   :: CrowdControlLevel+    , crowdControlMode        :: Bool+    , suggestedCommentSort    :: Maybe ItemSort+    , welcomeMessageText      :: Maybe Text+    , welcomeMessageEnabled   :: Bool+    , allowImages             :: Bool+    , allowVideos             :: Bool+    , allowPolls              :: Bool+    , allowCrossposts         :: Bool+    , allowChatPostCreation   :: Bool+    , spoilersEnabled         :: Bool+    , showMedia               :: Bool+    , showMediaPreview        :: Bool+      -- | Restrict all posting to only approved users+    , restrictPosting         :: Bool+      -- | Restrict all commenting to only approved users+    , restrictCommenting      :: Bool+    , over18                  :: Bool+    , collapseDeletedComments :: Bool+      -- | Allows the sub to appear in \"r/all\" and trending subs+    , defaultSet              :: Bool+      -- | Whether users may send modmail messages approval as a submitter+    , disableContribRequests  :: Bool+      -- | Allow users to enter custom report reasons+    , freeFormReports         :: Bool+      -- | Exclude posts from site-wide banned users in the modqueue+    , excludeBannedModqueue   :: Bool+      -- | Whether the \"original content\" tag is enabled+    , ocTagEnabled            :: Bool+      -- | Whether to mandate that all submissions be OC+    , allOC                   :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON SubredditSettings where+    parseJSON = withKind SubredditSettingsKind+                         "SubredditSettings"+                         (subredditSettingsP . Object)+      where+        subredditSettingsP =+            genericParseJSON defaultOptions { fieldLabelModifier }++        fieldLabelModifier = \case+            "allowCrossposts" -> "allow_post_crossposts"+            "over18" -> "over_18"+            "subredditID" -> "subreddit_id"+            "disableContribRequests" -> "disable_contributor_requests"+            "ocTagEnabled" -> "original_content_tag_enabled"+            "allOC" -> "all_original_content"+            s -> snakeCase s++instance ToForm SubredditSettings where+    toForm SubredditSettings { .. } = fromList+        $ [ ("sr", fullname subredditID)+          , ("api_type", "json")+          , ("title", title)+          , ("description", description)+          , ("submit_text", submitText)+          , ("submit_text_label", submitTextLabel)+          , ("header_hover_text", headerHoverText)+          , ("language", toQueryParam language)+          , ("type", toQueryParam subredditType)+          , ("link_type", toQueryParam contentOptions)+          , ("key_color", keyColor)+          , ("wikimode", toQueryParam wikimode)+          , ("wiki_edit_karma", tshow wikiEditKarma)+          , ("wiki_edit_age", tshow wikiEditAge)+          , ("comment_score_hide_mins", tshow commentScoreHideMins)+          , ("spam_comments", toQueryParam spamComments)+          , ("spam_selfposts", toQueryParam spamSelfposts)+          , ("spam_links", toQueryParam spamLinks)+          , ("crowd_control_level", toQueryParam crowdControlLevel)+          , ("crowd_control_chat_level", toQueryParam crowdControlChatLevel)+          , ("crowd_control_mode", toQueryParam crowdControlMode)+          , ("welcome_message_text", fromMaybe mempty welcomeMessageText)+          , ("welcome_message_enabled", toQueryParam welcomeMessageEnabled)+          , ("allow_images", toQueryParam allowImages)+          , ("allow_videos", toQueryParam allowVideos)+          , ("allow_polls", toQueryParam allowPolls)+          , ("allow_post_crossposts", toQueryParam allowCrossposts)+          , ("allow_chat_post_creation", toQueryParam allowChatPostCreation)+          , ("spoilers_enabled", toQueryParam spoilersEnabled)+          , ("show_media", toQueryParam showMedia)+          , ("show_media_preview", toQueryParam showMediaPreview)+          , ("restrict_posting", toQueryParam restrictPosting)+          , ("restrict_commenting", toQueryParam restrictCommenting)+          , ("over_18", toQueryParam over18)+          , ("collapse_delete_comments", toQueryParam collapseDeletedComments)+          , ("default_se", toQueryParam defaultSet)+          , ( "disable_contributor_requests"+            , toQueryParam disableContribRequests+            )+          , ("free_form_report", toQueryParam freeFormReports)+          , ("exclude_banned_modqueu", toQueryParam excludeBannedModqueue)+          , ("oc_tag_enable", toQueryParam ocTagEnabled)+          , ("all_original_conten", toQueryParam allOC)+          ]+        <> foldMap pure+                   (("suggested_comment_sort", ) . toQueryParam+                    <$> suggestedCommentSort)++-- | The setting for crowd controls, from lenient to strict+data CrowdControlLevel+    = Zero+    | One+    | Two+    | Three+    deriving stock ( Show, Eq, Generic, Ord, Enum )++instance FromJSON CrowdControlLevel where+    parseJSON = withScientific "CrowdControlLevel" $ \case+        0 -> pure Zero+        1 -> pure One+        2 -> pure Two+        3 -> pure Three+        _ -> mempty++instance ToHttpApiData CrowdControlLevel where+    toQueryParam = showTextData . fromEnum++-- | The privacy level for the subreddit+data SubredditType+    = Public+    | Restricted+    | Private+    | Archived+    | GoldRestricted+    | EmployeesOnly+    | GoldOnly+    | UserSubreddit+    deriving stock ( Show, Eq, Generic )++instance FromJSON SubredditType where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier }+      where+        constructorTagModifier = \case+            "UserSubreddit" -> "user"+            s               -> snakeCase s++instance ToHttpApiData SubredditType where+    toQueryParam = showTextData++-- | Permissible submissions on the subreddit+data ContentOptions+    = AnyContent+    | LinkOnly+    | SelfOnly+    deriving stock ( Show, Eq, Generic )++instance FromJSON ContentOptions where+    parseJSON = withText "ContentOptions" $ \case+        "any"  -> pure AnyContent+        "link" -> pure LinkOnly+        "self" -> pure SelfOnly+        _      -> mempty++instance ToHttpApiData ContentOptions where+    toQueryParam = \case+        AnyContent -> "any"+        LinkOnly   -> "link"+        SelfOnly   -> "self"++-- | The strength of the subreddit's spam filter+data SpamFilter+    = LowFilter+    | HighFilter+    | AllFilter+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData SpamFilter where+    toQueryParam = \case+        LowFilter  -> "low"+        HighFilter -> "high"+        AllFilter  -> "all"++instance FromJSON SpamFilter where+    parseJSON = withText "SpamFilter" $ \case+        "low"  -> pure LowFilter+        "high" -> pure HighFilter+        "all"  -> pure AllFilter+        _      -> mempty++-- | The editing mode for a subreddit\'s wiki+data Wikimode+    = EditDisabled+      -- ^ Only mods can edit+    | ApprovedEdit+      -- ^ Only mods and approved editors can edit+    | ContributorEdit+      -- ^ Any sub contributor can edit+    deriving stock ( Show, Eq, Generic, Ord )++instance FromJSON Wikimode where+    parseJSON = withText "WikiMode" $ \case+        "disabled" -> pure EditDisabled+        "modonly"  -> pure ApprovedEdit+        "anyone"   -> pure ContributorEdit+        _          -> mempty++instance ToHttpApiData Wikimode where+    toQueryParam = \case+        EditDisabled    -> "disabled"+        ApprovedEdit    -> "modonly"+        ContributorEdit -> "anyone"++-- | Represents an account that has been banned from a particular subreddit+data Ban = Ban+    { banID    :: RelID+    , username :: Username+    , userID   :: UserID+    , note     :: Maybe Text+    , since    :: UTCTime+      -- | The number of days remaining until the ban expires+    , daysLeft :: Maybe Word+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Ban where+    parseJSON = withObject "Ban" $ \o -> Ban <$> o .: "rel_id"+        <*> o .: "name"+        <*> o .: "id"+        <*> o .:? "note"+        <*> (integerToUTC <$> o .: "date")+        <*> o .:? "days_left"++-- The endpoints that list bans are a @Listing@, but only take a single option+-- to limit the listing to a single user+instance Paginable Ban where+    type PaginateOptions Ban = RelInfoOpts++    type PaginateThing Ban = RelID++    defaultOpts = RelInfoOpts { username = Nothing }++    getFullname Ban { banID } = banID++-- | Uniquely identifies a subreddit relationship, excluding mutes (see 'MuteID')+newtype RelID = RelID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance FromJSON RelID where+    parseJSON = withText "RelID" (coerce . dropTypePrefix RelKind)++instance Thing RelID where+    fullname (RelID bid) = prependType RelKind bid++-- | Identifies relationships representing muted users+newtype MuteID = MuteID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++instance FromJSON MuteID where+    parseJSON = withText "MuteID" (breakOnType "Mute")++instance Thing MuteID where+    fullname (MuteID bid) = "Mute_" <> bid++-- | Details of a new ban to apply to a user+data BanNotes = BanNotes+    {  -- | The message sent to the user+      banMessage :: Body+      -- | Reason for the ban, not sent to the user+    , banReason  :: Body+      -- | Duration in days for the ban. @Nothing@ implies infinite ban+    , duration   :: Maybe Word+      -- | A note about the ban. Not sent to the user+    , note       :: Body+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm BanNotes where+    toForm BanNotes { .. } = fromList+        $ [ ("ban_message", banMessage)+          , ("ban_reason", banReason)+          , ("note", note)+          ]+        <> foldMap pure (("duration", ) . tshow <$> duration)++--Modmail----------------------------------------------------------------------+-- | Moderator mail. Reddit no longer supports the older, message-based interface+-- for modmail+newtype Modmail = Modmail { conversations :: Seq ModmailConversation }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Modmail where+    parseJSON = withObject "Modmail" $ \o -> do+        cs <- getVals =<< o .: "conversations"+        ms <- o .: "messages"+        pure . Modmail $ cs <&> \c@ModmailConversation { objIDs } ->+            let messages = fromList . flip mapMaybe (toList objIDs)+                    $ \ModmailObjID { objID } -> HM.lookup objID ms+            in+                c { messages }++-- | A single modmail conversation+data ModmailConversation = ModmailConversation+    { modmailID      :: ModmailID+    , subject        :: Subject+      -- | This field may be empty, depending on how the 'ModmailConversation' was+      -- obtained. When parsed as part of a 'Modmail' or 'ConversationDetails', the+      -- messages will be present+    , messages       :: Seq ModmailMessage+    , numMessages    :: Integer+    , subreddit      :: SubredditName+      -- | The non-mod user participating in the conversation+    , participant    :: Maybe ModmailAuthor+    , objIDs         :: Seq ModmailObjID+    , lastUpdated    :: UTCTime+    , lastUserUpdate :: Maybe UTCTime+    , lastModUpdate  :: Maybe UTCTime+    , isHighlighted  :: Bool+    , isInternal     :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModmailConversation where+    parseJSON = withObject "ModmailConversation" $ \o -> ModmailConversation+        <$> o .: "id"+        <*> o .: "subject"+        -- There are no messages at the moment; they will be added later when the entire+        -- @Modmail@ or @ConversationDetails@ is parsed+        <*> pure mempty+        <*> o .: "numMessages"+        <*> ((.: "displayName") =<< o .: "owner")+        <*> optional (o .: "participant")+        <*> o .: "objIds"+        <*> (iso8601P =<< o .: "lastUpdated")+        <*> tryISO o "lastUserUpdate"+        <*> tryISO o "lastModUpdate"+        <*> o .: "isHighlighted"+        <*> o .: "isInternal"+      where+        tryISO o fld = maybe (pure Nothing) (iso8601P >=> pure . Just)+            =<< o .:? fld++iso8601P :: [Char] -> Parser UTCTime+iso8601P = fmap zonedTimeToUTC . iso8601ParseM++-- | Wrapper for parsing the JSON returned from the conversation details API endpoint.+-- This is formatted differently and has different fields than the modmail overview+-- endpoint+newtype ConversationDetails = ConversationDetails ModmailConversation+    deriving stock ( Show, Generic )++instance FromJSON ConversationDetails where+    parseJSON = withObject "ConversationDetails" $ \o -> do+        conversation <- o .: "conversation" <|> o .: "conversations"+        messages <- getVals =<< o .: "messages"+        pure . ConversationDetails $ conversation { messages }++-- | The ID of a particular modmail conversation+type ModmailID = Text++newtype BulkReadIDs = BulkReadIDs (Seq ModmailID)+    deriving stock ( Show, Generic )++instance FromJSON BulkReadIDs where+    parseJSON = withObject "BulkReadIDs"+        $ \o -> BulkReadIDs <$> o .: "conversation_ids"++-- | A mapping to a modmail action to its ID+data ModmailObjID = ModmailObjID { objID :: Text, key :: Text }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModmailObjID where+    parseJSON = withObject "ModmailObjID"+        $ \o -> ModmailObjID <$> o .: "id" <*> o .: "key"++-- | A single message in a 'ModmailConversation'+data ModmailMessage = ModmailMessage+    { modmailMessageID :: Text+    , author           :: ModmailAuthor+    , body             :: Body+    , bodyHTML         :: Body+    , date             :: UTCTime+    , isInternal       :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModmailMessage where+    parseJSON = withObject "ModmailMessage" $ \o -> ModmailMessage+        <$> o .: "id"+        <*> o .: "author"+        <*> o .: "bodyMarkdown"+        <*> o .: "body"+        <*> (iso8601P =<< o .: "date")+        <*> o .: "isInternal"++-- | An author in a 'ModmailConversation'; can be either a mod or a non-mod user+data ModmailAuthor = ModmailAuthor+    { name          :: Username+    , isAdmin       :: Bool+    , isDeleted     :: Bool+    , isHidden      :: Bool+    , isMod         :: Bool+    , isOP          :: Bool+    , isParticipant :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModmailAuthor where+    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "isOP" -> "isOp"+            s      -> s++-- | Options for filtering\/paginating modmail endpoints. Notably, this is an+-- entirely different mechanism than the usual @Listing@s elsewhere on Reddit+data ModmailOpts = ModmailOpts+    { after      :: Maybe ModmailID+    , subreddits :: Maybe [SubredditName]+      -- | Should be between 0 and 100. The implicit API default is 25+    , limit      :: Maybe Word+    , itemSort   :: Maybe ModmailSort+    , state      :: Maybe ModmailState+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm ModmailOpts where+    toForm ModmailOpts { .. } = fromList+        $ catMaybes [ ("after", ) . toQueryParam <$> after+                    , ("entity", ) . joinParams <$> subreddits+                    , ("limit", ) . toQueryParam <$> limit+                    , ("sort", ) . toQueryParam <$> itemSort+                    , ("state", ) . toQueryParam <$> state+                    ]++-- | Default options for filtering modmail+defaultModmailOpts :: ModmailOpts+defaultModmailOpts = ModmailOpts+    { after      = Nothing+    , subreddits = Nothing+    , limit      = Nothing+    , itemSort   = Nothing+    , state      = Nothing+    }++-- | Order to sort modmail in+data ModmailSort+    = FromUser+    | FromMod+    | RecentMail+    | UnreadMail+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData ModmailSort where+    toQueryParam = \case+        FromUser   -> "user"+        FromMod    -> "mod"+        RecentMail -> "recent"+        UnreadMail -> "unread"++-- | The state of the modmail, for use when filtering mail+data ModmailState+    = AllModmail+    | NewModmail+    | Appeals+    | Notifications+    | Inbox+    | InProgress+    | ArchivedMail+    | Highlighted+    | JoinRequests+    | ModModmail+    deriving stock ( Show, Eq, Generic )++instance Hashable ModmailState++instance ToHttpApiData ModmailState where+    toQueryParam = \case+        AllModmail    -> "all"+        NewModmail    -> "new"+        Appeals       -> "appeals"+        Notifications -> "notifications"+        Inbox         -> "inbox"+        InProgress    -> "inprogress"+        ArchivedMail  -> "archived"+        Highlighted   -> "highlighted"+        JoinRequests  -> "join_requests"+        ModModmail    -> "mod"++instance FromJSON ModmailState where+    parseJSON =+        genericParseJSON defaultOptions+                         { constructorTagModifier = modmailStateTagModifier }++instance FromJSONKey ModmailState where+    fromJSONKey = genericFromJSONKey --+        defaultJSONKeyOptions { keyModifier = modmailStateTagModifier }++modmailStateTagModifier :: [Char] -> [Char]+modmailStateTagModifier = \case+    "AllModmail"     -> "all"+    "NewModmail"     -> "new"+    "ArchivedMail"   -> "archived"+    "ModModmail"     -> "mod"+    s@"JoinRequests" -> snakeCase s+    s                -> toLower <$> s++-- | A new reply to a 'ModmailConversation'+data ModmailReply = ModmailReply+    { -- | Markdown-formatted body+      body           :: Body+      -- | Hides the identity of the reply author from non-mods+    , isAuthorHidden :: Bool+      -- | Indicates that this is a private moderator note, and thus+      -- hides it from non-mod users+    , isInternal     :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm ModmailReply where+    toForm = genericToForm defaultFormOptions++-- | 'ModmailReply' with default values for boolean fields+mkModmailReply :: Body -> ModmailReply+mkModmailReply body =+    ModmailReply { body, isAuthorHidden = False, isInternal = False }++-- | A new, mod-created modmail conversation+data NewConversation = NewConversation+    { -- | Must not be empty+      body           :: Body+      -- | Must not be empty, and should be less than 100 characters+    , subject        :: Subject+      -- | The intended recipient of the message+    , dest           :: Username+    , subreddit      :: SubredditName+      -- | Hides the identity of the reply author from non-mods+    , isAuthorHidden :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm NewConversation where+    toForm = genericToForm defaultFormOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "dest"      -> "to"+            "subreddit" -> "srName"+            s           -> s++--Modlog-----------------------------------------------------------------------+-- | An action issued by a moderator. The various fields prefixed @target@ can+-- refer to comments or submissions, where applicable+data ModAction = ModAction+    { modActionID     :: ModActionID+    , moderator       :: Username+    , action          :: ModActionType+    , created         :: UTCTime+    , description     :: Maybe Body+    , details         :: Maybe Text+    , targetID        :: Maybe ItemID+    , targetAuthor    :: Maybe Username+    , targetTitle     :: Maybe Title+    , targetPermalink :: Maybe URL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModAction where+    parseJSON = withKind ModActionKind "ModAction" $ \o -> ModAction+        <$> o .: "id"+        <*> o .: "mod"+        -- In case an uknown mod action field is encountered. Perhaps+        -- just make the field a @Maybe ModActionType@?+        <*> (o .: "action" <|> pure OtherModAction)+        <*> (integerToUTC <$> o .: "created_utc")+        <*> o .: "description"+        <*> o .: "details"+        -- It appears that the @target@ fields are only present+        -- when the mod action is taken on comments or submissions.+        -- Nevertheless, @optional@ can be applied here to make+        -- sure that parsing doesn't fail in case that assumption+        -- is mistaken+        <*> optional (o .: "target_fullname")+        <*> optional (o .: "target_author")+        <*> optional (o .: "target_title")+        <*> optional (o .: "target_permalink")++instance Paginable ModAction where+    type PaginateOptions ModAction = ModActionOpts++    type PaginateThing ModAction = ModActionID++    defaultOpts = ModActionOpts { action = Nothing, moderator = Nothing }++    optsToForm ModActionOpts { .. } = fromList+        $ catMaybes [ ("type", ) . toQueryParam <$> action+                    , ("mod", ) . toQueryParam <$> moderator+                    ]++    getFullname ModAction { modActionID } = modActionID++-- | Options for filtering\/paginating 'Listing's of 'ModAction's+data ModActionOpts = ModActionOpts+    { -- | Limits the returned 'Listing' to only this type of action+      action    :: Maybe ModActionType+      -- | Limits the returned 'Listing' to only those issued by this+      -- moderator+    , moderator :: Maybe Username+    }+    deriving stock ( Show, Eq, Generic )++-- | Identifier for an issued 'ModAction'+newtype ModActionID = ModActionID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++instance FromJSON ModActionID where+    parseJSON = withText "ModActionID" (breakOnType "ModAction")++instance Thing ModActionID where+    fullname (ModActionID mid) = "ModAction_" <> mid++-- | Classification for 'ModAction's+data ModActionType+    = BanUser+    | UnbanUser+    | SpamLink+    | RemoveLink+    | ApproveLink+    | SpamComment+    | RemoveComment+    | ApproveComment+    | AddModerator+    | ShowComment+    | InviteModerator+    | UninviteModerator+    | AcceptModeratorInvite+    | RemoveModerator+    | AddContributor+    | RemoveContributor+    | EditSettings+    | EditFlair+    | Distinguish+    | MarkNSFW+    | WikiBanned+    | WikiContrib+    | WikiUnbanned+    | WikiPageListed+    | RemoveWikiContributor+    | WikiRevise+    | WikiPermLevel+    | IgnoreReports+    | UnignoreReports+    | SetPermissions+    | SetSuggestedSort+    | Sticky+    | Unsticky+    | SetContestMode+    | UnsetContestMode+    | Lock+    | Unlock+    | MuteUser+    | UnmuteUser+    | CreateRule+    | EditRule+    | ReorderRules+    | DeleteRule+    | Spoiler+    | Unspoiler+    | MarkOriginalContent+    | Collections+    | Events+    | DeleteOverriddenClassification+    | OverrideClassification+    | ReorderModerators+    | SnoozeReports+    | UnsnoozeReports+      -- In case the preceding is not exhaustive:+    | OtherModAction+    deriving stock ( Show, Eq, Ord, Generic )++instance FromJSON ModActionType where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier }+      where+        constructorTagModifier = \case+            "WikiContrib" -> "wikicontributor"+            s             -> toLower <$> s++instance ToHttpApiData ModActionType where+    toQueryParam = showTextData++--Styles and images------------------------------------------------------------+-- | The CSS stylesheet and images for a subreddit+data Stylesheet = Stylesheet+    { stylesheet  :: Text+    , images      :: Seq SubredditImage+    , subredditID :: SubredditID+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Stylesheet where+    parseJSON = withKind StylesheetKind "Stylesheet" $ \o -> Stylesheet+        <$> o .: "stylesheet"+        <*> o .: "images"+        <*> o .: "subreddit_id"++-- | An image belonging to a 'Stylesheet'+data SubredditImage = SubredditImage+    { name :: Name+    , link :: Text -- ^ CSS link+    , url  :: URL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON SubredditImage where+    parseJSON = genericParseJSON defaultOptions++-- | Used to upload style assets and images to Reddit\'s servers with moderator+-- privileges+data S3ModerationLease = S3ModerationLease+    { action       :: URL+      -- | S3 metadata and headers+    , fields       :: HashMap Text Text+      -- | This is required to get the final upload URL+    , key          :: Text+    , websocketURL :: URL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON S3ModerationLease where+    parseJSON = withObject "S3ModerationLease" $ \o -> do+        lease <- o .: "s3ModerationLease"+        -- The protocol isn't included, for some reason+        action <- ("https:" <>) <$> lease .: "action"+        fields <- fieldsP =<< lease .: "fields"+        key <- maybe (fail "Missing key") pure $ HM.lookup "key" fields+        websocketURL <- o .: "websocketUrl"+        pure S3ModerationLease { .. }+      where+        fieldsP = withArray "S3ModerationLease.fields"+            $ fmap HM.fromList . traverse fieldP . toList++        fieldP  = withObject "S3ModerationLease.fields.field"+            $ \o -> (,) <$> o .: "name" <*> o .: "value"++-- | Represents one of the style images that may be uploaded+data StructuredStyleImage+    = BannerBackground+    | BannerAdditional+    | BannerHover+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData StructuredStyleImage where+    toQueryParam = \case+        BannerBackground -> "bannerBackgroundImage"+        BannerHover      -> "secondaryBannerPositionedImage"+        BannerAdditional -> "bannerPositionedImage"++-- | Alignment for certain 'StructuredStyleImage's+data StyleImageAlignment+    = LeftAligned+    | CenterAligned+    | RightAligned+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData StyleImageAlignment where+    toQueryParam = \case+        LeftAligned   -> "left"+        CenterAligned -> "center"+        RightAligned  -> "right"++--Misc-------------------------------------------------------------------------+-- | An individual statistic for a subreddit\'s traffic+data TrafficStat = TrafficStat+    { timestamp   :: UTCTime+    , uniqueViews :: Integer+    , totalViews  :: Integer+      -- | This statistic is only available in the @day@ and @month@ fields+      -- of a 'Traffic'+    , subscribers :: Maybe Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON TrafficStat where+    parseJSON = withArray "TrafficStat" (statP . toList)+      where+        statP (timestamp : uniqueViews : totalViews : rest) = TrafficStat+            <$> (integerToUTC <$> parseJSON timestamp)+            <*> parseJSON uniqueViews+            <*> parseJSON totalViews+            <*> case rest of+                subscribers : _ -> Just <$> parseJSON subscribers+                _               -> pure Nothing+        statP _ = mempty++-- | Traffic statistics for a given subreddit+data Traffic = Traffic+    { -- | Does not contain subscriber information+      hour  :: Seq TrafficStat+    , day   :: Seq TrafficStat+    , month :: Seq TrafficStat+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Traffic where+    parseJSON = genericParseJSON defaultOptions++-- | The language in which the subreddit is available, as configured in the+-- 'SubredditSettings'+newtype LanguageCode = LanguageCode Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON, ToHttpApiData )++pattern AF :: LanguageCode+pattern AF = LanguageCode "af"++pattern AR :: LanguageCode+pattern AR = LanguageCode "ar"++pattern BE :: LanguageCode+pattern BE = LanguageCode "be"++pattern BG :: LanguageCode+pattern BG = LanguageCode "bg"++pattern BS :: LanguageCode+pattern BS = LanguageCode "bs"++pattern CA :: LanguageCode+pattern CA = LanguageCode "ca"++pattern CS :: LanguageCode+pattern CS = LanguageCode "cs"++pattern CY :: LanguageCode+pattern CY = LanguageCode "cy"++pattern DA :: LanguageCode+pattern DA = LanguageCode "da"++pattern DE :: LanguageCode+pattern DE = LanguageCode "de"++pattern EL :: LanguageCode+pattern EL = LanguageCode "el"++pattern EN :: LanguageCode+pattern EN = LanguageCode "en"++pattern EO :: LanguageCode+pattern EO = LanguageCode "eo"++pattern ES :: LanguageCode+pattern ES = LanguageCode "es"++pattern ET :: LanguageCode+pattern ET = LanguageCode "et"++pattern EU :: LanguageCode+pattern EU = LanguageCode "eu"++pattern FA :: LanguageCode+pattern FA = LanguageCode "fa"++pattern FI :: LanguageCode+pattern FI = LanguageCode "fi"++pattern FR :: LanguageCode+pattern FR = LanguageCode "fr"++pattern GD :: LanguageCode+pattern GD = LanguageCode "gd"++pattern GL :: LanguageCode+pattern GL = LanguageCode "gl"++pattern HE :: LanguageCode+pattern HE = LanguageCode "he"++pattern HI :: LanguageCode+pattern HI = LanguageCode "hi"++pattern HR :: LanguageCode+pattern HR = LanguageCode "hr"++pattern HU :: LanguageCode+pattern HU = LanguageCode "hu"++pattern HY :: LanguageCode+pattern HY = LanguageCode "hy"++pattern ID :: LanguageCode+pattern ID = LanguageCode "id"++pattern IS :: LanguageCode+pattern IS = LanguageCode "is"++pattern IT :: LanguageCode+pattern IT = LanguageCode "it"++pattern JA :: LanguageCode+pattern JA = LanguageCode "ja"++pattern KO :: LanguageCode+pattern KO = LanguageCode "ko"++pattern LA :: LanguageCode+pattern LA = LanguageCode "la"++pattern LT :: LanguageCode+pattern LT = LanguageCode "lt"++pattern LV :: LanguageCode+pattern LV = LanguageCode "lv"++pattern MS :: LanguageCode+pattern MS = LanguageCode "ms"++pattern NL :: LanguageCode+pattern NL = LanguageCode "nl"++pattern NN :: LanguageCode+pattern NN = LanguageCode "nn"++pattern NO :: LanguageCode+pattern NO = LanguageCode "no"++pattern PL :: LanguageCode+pattern PL = LanguageCode "pl"++pattern PT :: LanguageCode+pattern PT = LanguageCode "pt"++pattern RO :: LanguageCode+pattern RO = LanguageCode "ro"++pattern RU :: LanguageCode+pattern RU = LanguageCode "ru"++pattern SK :: LanguageCode+pattern SK = LanguageCode "sk"++pattern SL :: LanguageCode+pattern SL = LanguageCode "sl"++pattern SR :: LanguageCode+pattern SR = LanguageCode "sr"++pattern SV :: LanguageCode+pattern SV = LanguageCode "sv"++pattern TA :: LanguageCode+pattern TA = LanguageCode "ta"++pattern TH :: LanguageCode+pattern TH = LanguageCode "th"++pattern TR :: LanguageCode+pattern TR = LanguageCode "tr"++pattern UK :: LanguageCode+pattern UK = LanguageCode "uk"++pattern VI :: LanguageCode+pattern VI = LanguageCode "vi"++pattern ZH :: LanguageCode+pattern ZH = LanguageCode "zh"
+ src/Network/Reddit/Types/Multireddit.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Multireddit+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Multireddit+    ( Multireddit(..)+    , MultiName+    , mkMultiName+    , MultiVisibility(..)+    , MultiPath(..)+    , NewMultiF(..)+    , NewMulti+    , MultiUpdate+    , multiUpdate+    , defaultMultiUpdate+    ) where++import           Control.Monad.Catch            ( MonadThrow )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , KeyValue((.=))+                 , ToJSON(..)+                 , Value(String)+                 , object+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Functor.Identity          ( Identity )+import           Data.Maybe                     ( catMaybes )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import qualified Data.Text                      as T+import           Data.Time                      ( UTCTime )+import           Data.Traversable               ( for )++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++import           Web.HttpApiData                ( ToHttpApiData(..) )++-- | An aggregation of individual 'Subreddit's+data Multireddit = Multireddit+    { name            :: MultiName+    , displayName     :: Text+    , subreddits      :: Seq SubredditName+    , created         :: UTCTime+    , description     :: Body+    , descriptionHTML :: Body+    , keyColor        :: Maybe RGBText+    , multipath       :: MultiPath+    , visibility      :: MultiVisibility+      -- | The path to the original multireddit from which+      -- this one was copied, if any, e.g.:+      -- @\/u\/<USERNAME>\/m\/<MULTINAME>@+    , copiedFrom      :: Maybe MultiPath+      -- | Whether the authenticated user can edit this+      -- multireddit+    , canEdit         :: Bool+    , over18          :: Maybe Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Multireddit where+    parseJSON = withKind LabeledMultiKind "Multireddit" $ \o -> Multireddit+        <$> o .: "name"+        <*> o .: "display_name"+        <*> (fromList <$> (subredditsP =<< o .: "subreddits"))+        <*> (integerToUTC <$> o .: "created_utc")+        <*> o .: "description_md"+        <*> o .: "description_html"+        <*> o .:? "key_color"+        <*> o .: "path"+        <*> o .: "visibility"+        <*> o .:? "copied_from"+        <*> o .: "can_edit"+        <*> o .:? "over_18"+      where+        subredditsP = withArray "[Object]" namesP++        namesP as = for (toList as) . withObject "Object" $ \o -> o .: "name"++-- | The name of a 'Multireddit', which may only contain alphanumeric characters+newtype MultiName = MultiName Text+    deriving stock ( Show, Generic )+    deriving newtype ( FromJSON, ToHttpApiData )+    deriving ( Eq ) via CIText MultiName++-- | Smart constructor for 'MultiName's, which may only contain alphanumeric+-- characters+mkMultiName :: MonadThrow m => Text -> m MultiName+mkMultiName = validateName Nothing Nothing "MultiName"++-- | The path to a 'Multireddit', of the form @\/user\/<USERNAME>\/m\/<MULTINAME>@+data MultiPath = MultiPath { username :: Username, multiname :: MultiName }+    deriving stock ( Show, Eq, Generic )++instance FromJSON MultiPath where+    parseJSON = withText "MultiPath" $ \t -> case T.splitOn "/" t of+        _ : "user" : uname : path : mname : _+            | path `elem` [ "m", "f" ] -> MultiPath+                <$> parseJSON (String uname)+                <*> parseJSON (String mname)+            | otherwise -> mempty+        _ -> mempty++instance ToHttpApiData MultiPath where+    toUrlPiece MultiPath { .. } =+        T.intercalate "/"+                      [ "user"+                      , toUrlPiece username+                      , "m"+                      , toUrlPiece multiname+                      ]++-- | The configured visibility level for a 'Multireddit'+data MultiVisibility+    = PrivateMulti+    | PublicMulti+    | HiddenMulti+    deriving stock ( Show, Eq, Generic, Ord )++instance FromJSON MultiVisibility where+    parseJSON = withText "MultiVisibility" $ \case+        "private" -> pure PrivateMulti+        "public"  -> pure PublicMulti+        "hidden"  -> pure HiddenMulti+        _         -> mempty++instance ToJSON MultiVisibility where+    toJSON = \case+        PrivateMulti -> "private"+        PublicMulti  -> "public"+        HiddenMulti  -> "hidden"++-- | Can represent either a new multireddit when parameterized by 'Identity', or+-- a multireddit update when parameterized by 'Maybe'. In both cases, @keyColor@+-- is an optional field+data NewMultiF f = NewMultiF+    { description :: HKD f Body+    , displayName :: HKD f Text+    , subreddits  :: HKD f (Seq SubredditName)+    , visibility  :: HKD f MultiVisibility+    , keyColor    :: Maybe RGBText+    }+    deriving stock ( Generic )++-- | An new multireddit, where all fields are required+type NewMulti = NewMultiF Identity++deriving stock instance Show NewMulti++instance ToJSON NewMulti where+    toJSON NewMultiF { .. } = object+        $ [ "description_md" .= description+          , "display_name" .= displayName+          , "subreddits" .= multiSubsObject subreddits+          , "visibility" .= visibility+          ]+        <> maybe mempty (pure . (.=) "key_color") keyColor++-- | An update to a multireddit, where all fields are optional. If a field+-- is not provided, it is omitted during JSON encoding+type MultiUpdate = NewMultiF Maybe++deriving stock instance Show MultiUpdate++instance ToJSON MultiUpdate where+    toJSON NewMultiF { .. } = object+        $ catMaybes [ ("description_md" .=) <$> description+                    , ("display_name" .=) <$> displayName+                    , ("subreddits" .=) . multiSubsObject <$> subreddits+                    , ("visibility" .=) <$> visibility+                    , ("key_color" .=) <$> keyColor+                    ]++-- | Convert a 'Multireddit' to a 'MultiUpdate'+multiUpdate :: Multireddit -> MultiUpdate+multiUpdate Multireddit { .. } = NewMultiF+    { description = Just description+    , displayName = Just displayName+    , subreddits  = Just subreddits+    , visibility  = Just visibility+    , keyColor+    }++-- | A 'MultiUpdate' with all @Nothing@ fields, for convenience+defaultMultiUpdate :: MultiUpdate+defaultMultiUpdate = NewMultiF+    { description = Nothing+    , displayName = Nothing+    , subreddits  = Nothing+    , visibility  = Nothing+    , keyColor    = Nothing+    }++-- | Endpoints receiving JSON for creating or updating multireddits expect an array+-- of single-member objects, of the form @{\"name\": ...}@, instead of the far+-- more sensical array of names that one would expect+multiSubsObject :: Functor t => t SubredditName -> t Value+multiSubsObject = fmap (object . pure . ("name" .=))
+ src/Network/Reddit/Types/Submission.hs view
@@ -0,0 +1,801 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Network.Reddit.Types.Submission+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Submission+    ( Submission(..)+    , SubmissionID(SubmissionID)+    , SubmissionContent(..)+    , submissionP+    , PollData(..)+    , PollOption(..)+    , PollOptionID+      -- * Collections+    , Collection(..)+    , CollectionLayout(..)+    , CollectionID+    , NewCollection(..)+      -- * Creating submissions+    , SubmissionOptions(..)+    , mkSubmissionOptions+    , NewSubmission(..)+    , S3UploadLease(..)+    , UploadType(..)+    , UploadResult(..)+    , CrosspostOptions(..)+    , mkCrosspostOptions+    , PostedCrosspost+    , Poll(..)+    , PollSubmission(PollSubmission)+    , mkPoll+    , GalleryImage(..)+    , mkGalleryImage+    , galleryImageToUpload+    , GallerySubmission(GallerySubmission)+    , InlineMedia(..)+    , InlineMediaType(..)+    , InlineMediaUpload(..)+    , inlineMediaToUpload+    , writeInlineMedia+    , Fancypants+    , PostedSubmission+      -- * Search+    , Search(..)+    , SearchSort(..)+    , SearchCategory+    , mkSearchCategory+    , SearchOpts(..)+    , ResultID(ResultID)+    , SearchSyntax(..)+    , mkSearch+    ) where++import           Control.Monad                  ( (<=<) )+import           Control.Monad.Catch            ( MonadThrow(throwM) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , KeyValue((.=))+                 , Object+                 , Options(..)+                 , ToJSON(toJSON)+                 , defaultOptions+                 , genericParseJSON+                 , genericToJSON+                 , object+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Aeson.Casing              ( snakeCase )+import           Data.Aeson.Types               ( Parser )+import           Data.Bool                      ( bool )+import           Data.Char                      ( toUpper )+import           Data.Coerce                    ( coerce )+import           Data.Foldable                  ( asum )+import qualified Data.Foldable                  as F+import           Data.Generics.Wrapped          ( wrappedTo )+import qualified Data.HashMap.Strict            as HM+import           Data.HashMap.Strict            ( HashMap )+import           Data.Ix                        ( Ix(inRange) )+import           Data.Maybe+                 ( catMaybes+                 , fromMaybe+                 , isJust+                 )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import qualified Data.Text                      as T+import           Data.Time                      ( UTCTime )++import           GHC.Exts                       ( IsList(..) )+import           GHC.Generics                   ( Generic )++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Subreddit++import           Web.FormUrlEncoded             ( ToForm(..) )+import           Web.HttpApiData                ( ToHttpApiData(toQueryParam)+                                                , showTextData+                                                )++-- | Unique, site-wide ID for a 'Submission'+newtype SubmissionID = SubmissionID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++instance FromJSON SubmissionID where+    parseJSON =+        withText "SubmissionID" (coerce . dropTypePrefix SubmissionKind)++instance Thing SubmissionID where+    fullname (SubmissionID sid) = prependType SubmissionKind sid++-- | A submitted self-text post or link+data Submission = Submission+    { submissionID  :: SubmissionID+    , title         :: Title+    , author        :: Username+    , content       :: SubmissionContent+    , subreddit     :: SubredditName+    , created       :: UTCTime+    , edited        :: Maybe UTCTime+    , permalink     :: URL+    , domain        :: Domain+    , numComments   :: Integer+    , score         :: Integer+    , ups           :: Maybe Integer+    , downs         :: Maybe Integer+    , upvoteRatio   :: Maybe Rational+    , gilded        :: Integer+    , userReports   :: Seq ItemReport+    , modReports    :: Seq ItemReport+    , numReports    :: Maybe Integer+    , distinguished :: Maybe Distinction+    , isOC          :: Bool+    , clicked       :: Bool+    , over18        :: Bool+    , locked        :: Bool+    , spoiler       :: Bool+    , pollData      :: Maybe PollData+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Submission where+    parseJSON = withKind SubmissionKind "Submission" submissionP++-- | Parse a 'Submission'+submissionP :: Object -> Parser Submission+submissionP o = do+    submissionID <- o .: "id"+    title <- o .: "title"+    author <- o .: "author"+    subreddit <- o .: "subreddit"+    created <- integerToUTC <$> o .: "created_utc"+    edited <- editedP =<< (o .: "edited")+    score <- o .: "score"+    ups <- o .:? "ups"+    downs <- o .:? "downs"+    content <- contentP o+    permalink <- o .: "permalink"+    numComments <- o .: "num_comments"+    gilded <- o .: "gilded"+    upvoteRatio <- o .:? "upvote_ratio"+    isOC <- o .: "is_original_content"+    clicked <- o .: "clicked"+    over18 <- o .: "over_18"+    locked <- o .: "locked"+    spoiler <- o .: "spoiler"+    userReports <- o .: "user_reports"+    modReports <- o .: "mod_reports"+    numReports <- o .:? "num_reports"+    distinguished <- o .:? "distinguished"+    pollData <- o .:? "poll_data"+    domain <- o .: "domain"+    pure Submission { .. }+  where+    contentP v = (v .: "is_self") >>= \case+        False -> asum [ ExternalLink <$> v .: "url", pure EmptySubmission ]+        True  -> asum [ SelfText <$> v .: "selftext" <*> v .: "selftext_html"+                      , pure EmptySubmission+                      ]++instance Paginable Submission where+    type PaginateOptions Submission = ItemOpts Submission++    type PaginateThing Submission = SubmissionID++    defaultOpts = defaultItemOpts++    getFullname Submission { submissionID } = submissionID++-- | The contents of the 'Submission'. Can be a self-post with a plaintext and+-- HTML body, an external link, or entirely empty+data SubmissionContent+    = SelfText Body Body+    | ExternalLink URL+    | EmptySubmission+    deriving stock ( Show, Eq, Generic )++-- | Data from an existing submission containing a poll. See 'Poll' for+-- submitting a new post with a poll+data PollData = PollData+    { options        :: Seq PollOption+      -- | Total number of votes cast for the poll+    , totalVoteCount :: Integer+      -- | Voting end date for the poll+    , votingEnds     :: UTCTime+      -- | The option selected by the authenticated user, if any+    , userSelection  :: Maybe PollOptionID+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON PollData where+    parseJSON = withObject "PollData" $ \o -> PollData <$> o .: "options"+        <*> o .: "total_vote_count"+        <*> (integerToUTC <$> o .: "voting_end_timestamp")+        <*> o .:? "user_selection"++-- | Single option in existing 'PollData'+data PollOption = PollOption+    { pollOptionID :: PollOptionID+    , text         :: Body+      -- | The total number of votes received thus far+    , voteCount    :: Integer+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON PollOption where+    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "pollOptionID" -> "id"+            s              -> snakeCase s++-- | Identifier for a 'PollOption'+type PollOptionID = Text++-- | Represents a Reddit collection+data Collection = Collection+    { collectionID :: CollectionID+    , author       :: Username+    , title        :: Title+    , subredditID  :: SubredditID+    , description  :: Body+    , permalink    :: URL+    , created      :: UTCTime+    , lastUpdated  :: UTCTime+    , linkIDs      :: Seq SubmissionID+      -- | These are the 'Submission's that correspond to+      -- the IDs in the @linkIDs@ fields. This field may+      -- be empty, depending on how the 'Collection' was+      -- obtained. Fetching all of the collections belonging+      -- to a subreddit will not include it, whereas fetching+      -- an individual collection by ID will+    , sortedLinks  :: Seq Submission+    , layout       :: Maybe CollectionLayout+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Collection where+    parseJSON = withObject "Collection" $ \o -> Collection+        <$> o .: "collection_id"+        <*> o .: "author_name"+        <*> o .: "title"+        <*> o .: "subreddit_id"+        <*> o .: "description"+        <*> o .: "permalink"+        <*> (doubleToUTC <$> o .: "created_at_utc")+        <*> (doubleToUTC <$> o .: "last_update_utc")+        <*> o .: "link_ids"+        <*> (linksP =<< o .:? "sorted_links")+        <*> o .:? "display_layout"+      where+        linksP      = \case+            Nothing -> pure mempty+            Just (Listing { children } :: Listing () Submission) ->+                pure children++        doubleToUTC = integerToUTC . round @Double++-- | The layout of the 'Collection' on the redesigned site+data CollectionLayout+    = Gallery+    | Timeline+    deriving stock ( Show, Eq, Generic )++instance FromJSON CollectionLayout where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = fmap toUpper }++instance ToHttpApiData CollectionLayout where+    toQueryParam = T.toUpper . showTextData++-- | A UUID identifier for a 'Collection'+type CollectionID = Text++-- | Data to create a new 'Collection' as a moderator action+data NewCollection = NewCollection+    { title       :: Title+    , description :: Body+    , subredditID :: SubredditID+    , layout      :: Maybe CollectionLayout+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm NewCollection where+    toForm NewCollection { .. } = fromList+        $ [ ("title", title)+          , ("description", description)+          , ("sr_fullname", fullname subredditID)+          ]+        <> foldMap pure (("display_layout", ) . toQueryParam <$> layout)++-- | Components to create a new submission+data SubmissionOptions = SubmissionOptions+    { -- | Should be <= 300 characters in length+      title        :: Title+    , subreddit    :: SubredditName+    , nsfw         :: Bool+    , sendreplies  :: Bool+    , resubmit     :: Bool+    , spoiler      :: Bool+      -- | The UUID of an existing 'Collection' to which to add+      -- the new submission+    , collectionID :: Maybe CollectionID+    , flairID      :: Maybe FlairID+      -- |+      -- If this is chosen, two conditions must be met that are not+      -- currently enforced by this library:+      --    * The @flairID@ field above must also be provided+      --    * The @textEditable@ field of the associated 'FlairTemplate'+      --      must also be @True@+    , flairText    :: Maybe FlairText+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm SubmissionOptions where+    toForm SubmissionOptions { .. } = fromList+        $ [ ("sr", wrappedTo subreddit)+          , ("title", title)+          , ("nsfw", toQueryParam nsfw)+          , ("spoiler", toQueryParam spoiler)+          , ("sendreplies", toQueryParam sendreplies)+          , ("resubmit", toQueryParam resubmit)+          , ("extension", "json")+          , ("api_type", "json")+          ]+        <> catMaybes [ ("collection_id", ) <$> collectionID+                     , ("flair_id", ) <$> flairID+                     , ("flair_text", ) . toQueryParam <$> flairText+                     ]++-- | The type of 'SubmissionOptions' to submit to Reddit. In general, this+-- should not be used directly. See instead the various @submit@ actions+-- in "Network.Reddit.Submission"+data NewSubmission+    = SelfPost Body SubmissionOptions+    | WithInlineMedia Fancypants SubmissionOptions+      -- ^ The body should be generated using 'InlineMedia' and converted to+      -- \"fancypants\" style markdown. Please see+      -- 'Network.Reddit.Actions.Submission.submitWithInlineMedia', which+      -- handles this+    | Link URL SubmissionOptions+    | ImagePost UploadURL SubmissionOptions+      -- ^ Please see 'Network.Reddit.Actions.Submission.submitImage' in order+      -- to create an image submission. The URL must point to a valid image+      -- hosted by Reddit+    | VideoPost UploadURL UploadURL Bool SubmissionOptions+      -- ^ See the note for 'ImagePost' about 'UploadURL's. The @Bool@ argument+      -- specifies if this is \"videogif\" media. The second 'UploadURL' points+      -- to a Reddit-hosted thumbnail image+    deriving stock ( Show, Eq, Generic )++instance ToForm NewSubmission where+    toForm = \case+        SelfPost body os ->+            fromList [ ("kind", "self"), ("text", body) ] <> toForm os+        WithInlineMedia body os ->+            fromList [ ("kind", "self"), ("richtext_json", textEncode body) ]+            <> toForm os+        Link url os ->+            fromList [ ("kind", "link"), ("url", url) ] <> toForm os+        ImagePost url os ->+            fromList [ ("kind", "image"), ("url", toQueryParam url) ]+            <> toForm os+        VideoPost url thmb videogif os ->+            fromList [ ("kind", bool "video" "videogif" videogif)+                     , ("url", toQueryParam url)+                     , ("video_poster_url", toQueryParam thmb)+                     ]+            <> toForm os++-- | Create a 'SubmissionOptions' with default values for most fields+mkSubmissionOptions :: SubredditName -> Title -> SubmissionOptions+mkSubmissionOptions subreddit title = SubmissionOptions+    { nsfw         = False+    , sendreplies  = True+    , resubmit     = True+    , spoiler      = False+    , collectionID = Nothing+    , flairID      = Nothing+    , flairText    = Nothing+    , ..+    }++-- | Used to upload style assets and images to Reddit\'s servers when+-- submitting content+data S3UploadLease = S3UploadLease+    { action       :: URL+      -- | S3 metadata and headers+    , fields       :: HashMap Text Text+      -- | This is required to get the final upload URL+    , key          :: Text+    , websocketURL :: URL+    , assetID      :: UploadURL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON S3UploadLease where+    parseJSON = withObject "S3UploadLease" $ \o -> do+        lease <- o .: "args"+        -- The protocol isn't included, for some reason+        action <- ("https:" <>) <$> lease .: "action"+        fields <- fieldsP =<< lease .: "fields"+        key <- maybe (fail "Missing key") pure $ HM.lookup "key" fields+        websocketURL <- (.: "websocket_url") =<< o .: "asset"+        assetID <- (.: "asset_id") =<< o .: "asset"+        pure S3UploadLease { .. }+      where+        fieldsP = withArray "S3UploadLease.fields"+            $ fmap HM.fromList . traverse fieldP . toList++        fieldP  = withObject "S3UploadLease.fields.field"+            $ \o -> (,) <$> o .: "name" <*> o .: "value"++-- | Used to distinguish upload types when creating submissions with media+data UploadType+    = SelfPostUpload+    | LinkUpload+    | GalleryUpload+    deriving stock ( Show, Eq, Generic )++-- | Result issued from a websocket connection after uploading media+data UploadResult = UploadResult { resultType :: Text, redirectURL :: URL }+    deriving stock ( Show, Eq, Generic )++instance FromJSON UploadResult where+    parseJSON = withObject "UploadResult" $ \o -> UploadResult <$> o .: "type"+        <*> ((.: "redirect") =<< o .: "payload")++-- | Options for crossposting a submission+data CrosspostOptions = CrosspostOptions+    { subreddit   :: SubredditName+    , title       :: Title+    , nsfw        :: Bool+    , sendreplies :: Bool+    , spoiler     :: Bool+    , flairID     :: Maybe FlairID+      -- |+      -- If this is chosen, two conditions must be met that are not+      -- currently enforced by this library:+      --    * The @flairID@ field above must also be provided+      --    * The @textEditable@ field of the associated 'FlairTemplate'+      --      must also be @True@+    , flairText   :: Maybe FlairText+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm CrosspostOptions where+    toForm CrosspostOptions { .. } = fromList+        $ [ ("sr", wrappedTo subreddit)+          , ("title", title)+          , ("nsfw", toQueryParam nsfw)+          , ("spoiler", toQueryParam spoiler)+          , ("sendreplies", toQueryParam sendreplies)+          , ("kind", "crosspost")+          , ("api_type", "json")+          ]+        <> catMaybes [ ("flair_id", ) <$> flairID+                     , ("flair_text", ) . toQueryParam <$> flairText+                     ]++-- | Wrapper for getting the submission ID after completing a crosspost+newtype PostedCrosspost = PostedCrosspost SubmissionID+    deriving stock ( Show, Generic )++instance FromJSON PostedCrosspost where+    parseJSON = withObject "PostedLiveThread"+        $ fmap PostedCrosspost . ((.: "id") <=< (.: "data") <=< (.: "json"))++-- | 'CrosspostOptions' with default values for most fields+mkCrosspostOptions :: SubredditName -> Title -> CrosspostOptions+mkCrosspostOptions subreddit title = CrosspostOptions+    { nsfw        = False+    , sendreplies = True+    , spoiler     = False+    , flairID     = Nothing+    , flairText   = Nothing+    , ..+    }++-- | A Reddit poll. See 'mkPoll' to create a new one satisfying Reddit+-- constraints on poll options and duration+data Poll t = Poll+    { -- | Between 2 and 6 total options+      options  :: t Text+      -- | The number of days for the poll to run+    , duration :: Word+      -- | Optional self text for the body of the submission+    , selftext :: Maybe Body+    }+    deriving stock ( Generic )++deriving stock instance (Show (t Text)) => Show (Poll t)++deriving stock instance (Eq (t Text)) => Eq (Poll t)++-- | Wrapper providing a single 'ToJSON' instance for 'Poll's and+-- 'SubmissionOptions's together+data PollSubmission t = PollSubmission (Poll t) SubmissionOptions+    deriving stock ( Generic )++instance Foldable t => ToJSON (PollSubmission t) where+    toJSON (PollSubmission Poll { .. } SubmissionOptions { .. }) =+        object [ "sr" .= subreddit+               , "title" .= title+               , "resubmit" .= resubmit+               , "sendreplies" .= sendreplies+               , "nsfw" .= nsfw+               , "spoiler" .= spoiler+               , "options" .= F.toList options+               , "duration" .= duration+               , "text" .= fromMaybe mempty selftext+               ]++-- | Create a new 'Poll', validating the following constraints:+--      * The @duration@ is between 1 and 7+--      * The number of @options@ is between 2 and 6+mkPoll :: (Foldable t, MonadThrow m) => t Text -> Word -> m (Poll t)+mkPoll options duration+    | not $ inRange (1, 7) duration =+        throwM $ OtherError "mkPoll: duration must be between 1 and 7"+    | not . inRange (2, 6) $ length options = throwM+        $ OtherError "mkPoll: number of options must be between 2 and 6"+    | otherwise = pure $ Poll { selftext = Nothing, .. }++-- | A single image in a gallery submission+data GalleryImage = GalleryImage+    { imagePath   :: FilePath+      -- | Optional caption+    , caption     :: Maybe Body+      -- | Optional outbound URL+    , outboundURL :: Maybe URL+    }+    deriving stock ( Show, Eq, Generic )++-- | Create a 'GalleryImage' with default values for the @caption@ and+-- @outboundURL@ fields+mkGalleryImage :: FilePath -> GalleryImage+mkGalleryImage imagePath =+    GalleryImage { caption = Nothing, outboundURL = Nothing, .. }++-- | As a 'GalleryImage', but after obtaining the URL for the Reddit-hosted+-- image+data GalleryUploadImage = GalleryUploadImage+    { caption     :: Body+    , outboundURL :: URL+      -- | Points to Reddit-hosted image+    , mediaID     :: UploadURL+    }+    deriving stock ( Generic )++instance ToJSON GalleryUploadImage where+    toJSON = genericToJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "mediaID"     -> "media_id"+            "outboundURL" -> "outbound_url"+            s             -> s++-- | Convert a 'GalleryImage' to to 'GalleryUploadImage' after obtaining the+-- 'UploadURL'+galleryImageToUpload :: GalleryImage -> UploadURL -> GalleryUploadImage+galleryImageToUpload GalleryImage { .. } mediaID = GalleryUploadImage+    { caption     = fromMaybe mempty caption+    , outboundURL = fromMaybe mempty outboundURL+    , ..+    }++-- | Wrapper providing a single 'ToJSON' instance for a container of+-- 'GalleryUploadImage's and 'SubmissionOptions's together+data GallerySubmission t =+    GallerySubmission (t GalleryUploadImage) SubmissionOptions+    deriving stock ( Generic )++instance Foldable t => ToJSON (GallerySubmission t) where+    toJSON (GallerySubmission items SubmissionOptions { .. }) =+        object [ "sr" .= subreddit+               , "title" .= title+               , "sendreplies" .= sendreplies+               , "nsfw" .= nsfw+               , "spoiler" .= spoiler+               , "items" .= F.toList items+               , "show_error_list" .= True+               , "api_type" .= ("json" :: Text)+               ]++-- | A piece of inline media that can be added to a self-text post+data InlineMedia = InlineMedia+    { mediaType :: InlineMediaType+      -- | The path must be valid and the file type must correspond+      -- to the provided @mediaType@ field+    , mediaPath :: FilePath+      -- | This corresponds to a placeholder in the self-text of the+      -- submission. This will be filled in with generated markdown.+      -- If the key is absent from the text, the inline media will+      -- not be included in the final body. See+      -- 'Network.Reddit.Actions.Submission.submitWithInlineMedia'+      -- for more details+    , key       :: Text+      -- | Optional caption for the media+    , caption   :: Maybe Body+    }+    deriving stock ( Show, Eq, Generic )++-- | The type of inline media+data InlineMediaType+    = InlineImage+    | InlineGIF+    | InlineVideo+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData InlineMediaType where+    toQueryParam = \case+        InlineImage -> "img"+        InlineGIF   -> "gif"+        InlineVideo -> "video"++-- | As an 'InlineMedia', but after obtaining the URL for the Reddit-hosted+-- image+data InlineMediaUpload = InlineMediaUpload+    { mediaType :: InlineMediaType+    , mediaID   :: UploadURL --+    , caption   :: Body+    , key       :: Text+    }+    deriving stock ( Show, Eq, Generic )++-- | Convert an 'InlineMedia' to 'InlineMediaUpload' after obtaining the+-- 'UploadURL'+inlineMediaToUpload :: InlineMedia -> UploadURL -> InlineMediaUpload+inlineMediaToUpload InlineMedia { .. } mediaID =+    InlineMediaUpload { caption = fromMaybe mempty caption, .. }++-- | Write an 'InlineMediaUpload' in markdown format+writeInlineMedia :: InlineMediaUpload -> Body+writeInlineMedia InlineMediaUpload { .. } =+    mconcat [ "\n\n"+            , "!["+            , toQueryParam mediaType+            , "]"+            , "("+            , toQueryParam mediaID+            , " "+            , "\""+            , caption+            , "\""+            , ")"+            , "\n\n"+            ]++-- | Represents richtext JSON object. This should be generated through an+-- API endpoint+newtype Fancypants = Fancypants Object+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToJSON )++instance FromJSON Fancypants where+    parseJSON = withObject "Fancypants" $ fmap Fancypants . (.: "output")++-- | Wrapper for getting the URL from the JSON object that is returned when+-- posting a new submissions+newtype PostedSubmission = PostedSubmission URL+    deriving stock ( Show, Generic )++instance FromJSON PostedSubmission where+    parseJSON = withObject "PostedSubmission"+        $ fmap PostedSubmission . ((.: "url") <=< (.: "data") <=< (.: "json"))++--Search-----------------------------------------------------------------------+-- | The text to search, along with an optional 'SubredditName'+data Search = Search+    { -- | The text to search+      q         :: Text+      -- | If @Nothing@, will perform search. Should be <= 512 characters in length+    , subreddit :: Maybe SubredditName+      -- | If @Nothing@, defaults to 'Lucene'+    , syntax    :: Maybe SearchSyntax+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm Search where+    toForm Search { .. } =+        fromList [ ("q", q)+                 , ("syntax", toQueryParam $ fromMaybe Lucene syntax)+                 , ("restrict_sr", toQueryParam $ isJust subreddit)+                 ]++instance Paginable Search where+    type PaginateOptions Search = SearchOpts++    type PaginateThing Search = Text++    defaultOpts = SearchOpts+        { searchSort = ByRelevance, searchTime = AllTime, category = Nothing }++-- | Create a new 'Search' by providing the query, with defaults for the other+-- fields+mkSearch :: Text -> Search+mkSearch q = Search { subreddit = Nothing, syntax = Nothing, .. }++-- | Options for paginating and filtering 'Search'es+data SearchOpts = SearchOpts+    { searchSort :: SearchSort+    , searchTime :: Time+    , category   :: Maybe SearchCategory+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm SearchOpts where+    toForm SearchOpts { .. } = fromList+        $ [ ("sort", toQueryParam searchSort)+          , ("t", toQueryParam searchTime)+          ]+        <> foldMap pure (("category", ) . coerce <$> category)++-- | The sort order for 'Search'es+data SearchSort+    = ByRelevance+    | ByNew+    | ByHot+    | ByTop+    | ByComments+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData SearchSort where+    toQueryParam = T.drop 2 . showTextData++-- | The category for the 'Search'+newtype SearchCategory = SearchCategory Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq )++-- | Create a 'SearchCategory' from 'Text',  the length of which must not exceed+-- 5 characters+mkSearchCategory :: MonadThrow m => Text -> m SearchCategory+mkSearchCategory txt+    | T.length txt > 5 =+        throwM $ OtherError "mkSearchCategory: length must be <= 5 characters"+    | otherwise = pure $ SearchCategory txt++-- | The syntax to use in the 'Search'+data SearchSyntax+    = Lucene+    | Cloudsearch+    | PlainSyntax+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData SearchSyntax where+    toQueryParam = \case+        PlainSyntax -> "plain"+        s           -> showTextData s++-- | A wrapper around 'SubmissionID's that allows @Listing ResultID a@ to be+-- distinguished from @Listing SubmissionID a@+newtype ResultID = ResultID SubmissionID+    deriving stock ( Show, Generic )+    deriving newtype ( FromJSON, Thing )
+ src/Network/Reddit/Types/Subreddit.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}++{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Network.Reddit.Types.Subreddit+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Subreddit+    ( SubredditName+    , mkSubredditName+    , SubredditID(SubredditID)+    , Subreddit(..)+    , RecsList+    , NameSearchResults+      -- * Rules\/requirements+    , SubredditRule(..)+    , RuleList+    , NewSubredditRule(..)+    , PostedSubredditRule+    , RuleType(..)+    , PostRequirements(..)+    , BodyRestriction(..)+    ) where++import           Control.Applicative           ( Alternative((<|>)) )+import           Control.Monad                 ( (<=<) )+import           Control.Monad.Catch           ( MonadThrow )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , Options(..)+                 , ToJSON+                 , ToJSON(..)+                 , Value(Object)+                 , decodeStrict+                 , defaultOptions+                 , genericParseJSON+                 , withArray+                 , withObject+                 , withText+                 )+import           Data.Aeson.Casing             ( snakeCase )+import           Data.Maybe                    ( catMaybes, fromMaybe )+import           Data.Sequence                 ( Seq )+import           Data.Text                     ( Text )+import qualified Data.Text.Encoding            as T+import           Data.Time                     ( UTCTime )++import           GHC.Exts                      ( IsList(fromList, toList) )+import           GHC.Generics                  ( Generic )++import           Lens.Micro++import           Network.Reddit.Types.Internal++import           Web.FormUrlEncoded            ( ToForm(toForm) )+import           Web.HttpApiData               ( ToHttpApiData(..) )++-- | Information about a subreddit. Fields prefixed with @userIs@ below apply to+-- the currently authenticated user+data Subreddit = Subreddit+    { subredditID        :: SubredditID+    , name               :: SubredditName+    , title              :: Title+    , created            :: UTCTime+      -- | The description of the subreddit in markdown+    , description        :: Body+    , descriptionHTML    :: Maybe Body+      -- | Description as shown in searches+    , publicDescription  :: Body+    , subscribers        :: Integer+    , over18             :: Bool+    , userIsBanned       :: Maybe Bool+    , userIsModerator    :: Maybe Bool+    , userIsSubscriber   :: Maybe Bool+      -- | Whether users can assign their own link flair+    , canAssignLinkFlair :: Maybe Bool+      -- | Whether users can assign their own user flair+    , canAssignUserFlair :: Maybe Bool+      -- | Whether the subreddit is quarantined+    , quarantine         :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Subreddit where+    parseJSON = withKind SubredditKind "Subreddit" $ \o -> Subreddit+        <$> o .: "id"+        <*> o .: "display_name"+        <*> o .: "title"+        <*> (integerToUTC <$> o .: "created_utc")+        <*> o .: "description"+        <*> o .: "description_html"+        <*> o .: "public_description"+        <*> o .: "subscribers"+        <*> o .: "over18"+        <*> o .: "user_is_banned"+        <*> o .: "user_is_moderator"+        <*> o .: "user_is_subscriber"+        <*> o .:? "can_assign_link_flair"+        <*> o .:? "can_assign_user_flair"+        <*> o .: "quarantine"++-- Dummy instance so that @Listing ... Subreddit@ can work with convenience+-- actions+instance Paginable Subreddit where+    type PaginateOptions Subreddit = ()++    type PaginateThing Subreddit = SubredditID++    defaultOpts = ()++    optsToForm _ = mempty++    getFullname Subreddit { subredditID } = subredditID++-- | The name of a subreddit+newtype SubredditName = SubredditName Text+    deriving stock ( Show, Generic )+    deriving newtype ( FromJSON, ToJSON, ToHttpApiData )+    deriving ( Eq ) via CIText SubredditName++-- | Smart constructor for 'SubredditName', which must be between 3 and 20 chars,+-- and may only include upper/lowercase alphanumeric chars, underscores, and+-- hyphens+mkSubredditName :: MonadThrow m => Text -> m SubredditName+mkSubredditName = validateName Nothing Nothing "SubredditName"++-- | Unique site-wide identifier for a subreddit+newtype SubredditID = SubredditID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON )++instance Thing SubredditID where+    fullname (SubredditID sid) = prependType SubredditKind sid++-- | Wrapper for parsing an array of recommended @SubredditName@s, which are+-- given as single-field JSON objects+newtype RecsList = RecsList (Seq SubredditName)+    deriving stock ( Show, Generic )++instance FromJSON RecsList where+    parseJSON = withArray "RecsList"+        $ fmap (RecsList . fromList) . traverse snameP . toList+      where+        snameP = withObject "Object" (.: "sr_name")++-- | Wrapper for parsing an object of @SubredditName@ results when searching+-- subreddits by name+newtype NameSearchResults = NameSearchResults (Seq SubredditName)+    deriving stock ( Show, Generic )++instance FromJSON NameSearchResults where+    parseJSON = withObject "NameSearchResults"+        $ fmap NameSearchResults . (.: "names")++-- | A 'Subreddit' rule. If you are a moderator, you can update the @shortName@,+-- @description@, @violationReason@, and @ruleType@ fields. See+-- 'Network.Reddit.Actions.Moderation.reorderSubredditRules'. New rules may also+-- be created with 'NewSubredditRule's+data SubredditRule = SubredditRule+    { description     :: Body+    , descriptionHTML :: Body+    , shortName       :: Name+    , created         :: UTCTime+    , priority        :: Word+    , violationReason :: Maybe Text+    , ruleType        :: Maybe RuleType+    }+    deriving stock ( Show, Eq, Generic )++-- | Depending on the endpoint, the JSON fields are either camel- or+-- snake-cased+instance FromJSON SubredditRule where+    parseJSON = withObject "SubredditRule" $ \o -> SubredditRule+        <$> o .: "description"+        <*> (o .: "description_html" <|> o .: "descriptionHtml")+        <*> (o .: "short_name" <|> o .: "shortName")+        <*> (integerToUTC <$> (o .: "created_utc" <|> o .: "createdUtc"))+        <*> o .: "priority"+        <*> (o .: "violation_reason" <|> o .: "violationReason")+        <*> o .:? "kind"++instance ToForm SubredditRule where+    toForm SubredditRule { .. } = fromList+        $ [ ("description", description), ("short_name", shortName) ]+        <> catMaybes [ ("violation_reason", ) <$> violationReason+                     , ("kind", ) . toQueryParam <$> ruleType+                     ]++-- | Wrapper to parse JSON from endpoints that list 'SubredditRule's+newtype RuleList = RuleList (Seq SubredditRule)+    deriving stock ( Show, Generic )++instance FromJSON RuleList where+    parseJSON = withObject "RuleList"+        $ fmap (RuleList . fromList) . (parseRules <=< (.: "rules"))+      where+        parseRules = withArray "[SubredditRule]" (traverse parseJSON . toList)++-- | Represents a new 'SubredditRule' that can be created by moderators+data NewSubredditRule = NewSubredditRule+    { shortName       :: Name+    , ruleType        :: RuleType+    , description     :: Body+      -- | If @Nothing@, will be set to the same text as+      -- the @shortName@ provided+    , violationReason :: Maybe Text+    }+    deriving stock ( Show, Eq, Generic )++instance ToForm NewSubredditRule where+    toForm NewSubredditRule { .. } =+        fromList [ ("description", description)+                 , ("short_name", shortName)+                 , ("kind", toQueryParam ruleType)+                 , ("violation_reason", fromMaybe shortName violationReason)+                 ]++-- | Wrapper for parsing newly created 'SubredditRule's, after POSTing a+-- 'NewSubredditRule'. Rather unbelievably, Reddit transmits these new+-- rules as a JSON object ... in a single element array ... /encoded as a string/+-- ... inside another object!+newtype PostedSubredditRule = PostedSubredditRule SubredditRule+    deriving stock ( Show, Generic )++instance FromJSON PostedSubredditRule where+    parseJSON = withObject "PostedSubredditRule" $ \o ->+        (o .: "json" >>= (.: "data") >>= (.: "rules"))+        <&> decodeStrict . T.encodeUtf8+        >>= \case+            Just [ r@(Object _) ] -> PostedSubredditRule <$> parseJSON r+            _ -> mempty++-- | The type of item that a 'SubredditRule' applies to+data RuleType+    = CommentRule+    | LinkRule+    | AllRule+    deriving stock ( Show, Eq, Generic, Ord )++instance FromJSON RuleType where+    parseJSON = genericParseJSON defaultOptions { constructorTagModifier }+      where+        constructorTagModifier = \case+            "CommentRule" -> "comment"+            "LinkRule"    -> "link"+            "AllRule"     -> "all"+            _             -> mempty++instance ToHttpApiData RuleType where+    toQueryParam = \case+        CommentRule -> "comment"+        LinkRule    -> "link"+        AllRule     -> "all"++-- | Mod-created requirements for posting in a subreddit+data PostRequirements = PostRequirements+    { bodyBlacklistedStrings  :: [Text]+    , bodyRestrictionPolicy   :: BodyRestriction+    , domainBlacklist         :: [Text]+      -- | If present, submissions must be from one of the listed domains+    , domainWhitelist         :: [Text]+    , isFlairRequired         :: Bool+    , titleBlacklistedStrings :: [Text]+      -- |If present, submission titles must contain one of the given strings+    , titleRequiredStrings    :: [Text]+    , titleTextMaxLength      :: Maybe Word+    , titleTextMinLength      :: Maybe Word+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON PostRequirements where+    parseJSON =+        genericParseJSON defaultOptions { fieldLabelModifier = snakeCase }++-- | Rules concerning the presence of self-text bodies in posts+data BodyRestriction+    = BodyRequired+    | BodyNotAllowed+    | NoRestriction+    deriving stock ( Show, Eq, Generic )++instance FromJSON BodyRestriction where+    parseJSON = withText "BodyRestriction" $ \case+        "required"   -> pure BodyRequired+        "notAllowed" -> pure BodyNotAllowed+        "none"       -> pure NoRestriction+        _            -> mempty+
+ src/Network/Reddit/Types/Widget.hs view
@@ -0,0 +1,971 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Widget+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Widget+    ( SubredditWidgets(..)+    , Widget(..)+    , WidgetID(WidgetID)+    , WidgetSection(..)+    , ShortName+    , mkShortName+    , WidgetList+    , WidgetStyles(..)+      -- * Individual widget types+      -- | All of the widget types in this module have a @widgetID@ field+      -- with the type @Maybe WidgetID@. This field /should/ be present+      -- when fetching existing widgets, but should be left as @Nothing@+      -- if creating a new widget+    , ButtonWidget(..)+    , Button(..)+    , ButtonImage(..)+    , ButtonText(..)+    , ButtonHover(..)+    , ImageHover(..)+    , TextHover(..)+    , CalendarWidget(..)+    , CalendarConfig(..)+    , defaultCalendarConfig+    , CommunityListWidget(..)+    , CommunityInfo(..)+    , mkCommunityInfo+    , CustomWidget(..)+    , ImageData(..)+    , IDCardWidget(..)+    , ImageWidget(..)+    , Image(..)+    , MenuWidget(..)+    , MenuChild(..)+    , MenuLink(..)+    , Submenu(..)+    , ModeratorsWidget(..)+    , ModInfo(..)+    , PostFlairWidget(..)+    , mkPostFlairWidget+    , PostFlairInfo(..)+    , PostFlairWidgetDisplay(..)+    , RulesWidget(..)+    , RulesDisplay(..)+    , TextAreaWidget(..)+    , mkTextAreaWidget+    ) where++import           Control.Applicative            ( optional )+import           Control.Monad                  ( guard )+import           Control.Monad.Catch            ( MonadThrow(throwM) )++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , FromJSON(..)+                 , GToJSON'+                 , KeyValue((.=))+                 , Object+                 , Options(..)+                 , SumEncoding(UntaggedValue)+                 , ToJSON+                 , ToJSON(..)+                 , Value(..)+                 , Zero+                 , defaultOptions+                 , genericParseJSON+                 , genericToJSON+                 , object+                 , withObject+                 , withText+                 )+import           Data.Aeson.Types               ( Parser )+import           Data.Coerce                    ( coerce )+import qualified Data.HashMap.Strict            as HM+import           Data.HashMap.Strict            ( HashMap )+import           Data.Maybe+                 ( catMaybes+                 , fromMaybe+                 , mapMaybe+                 )+import           Data.Sequence                  ( Seq )+import           Data.Text                      ( Text )+import qualified Data.Text                      as T++import           GHC.Exts                       ( IsList(fromList, Item) )+import           GHC.Generics                   ( Generic(Rep) )++import           Lens.Micro++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Internal+import           Network.Reddit.Types.Subreddit++import           Web.HttpApiData                ( ToHttpApiData(..)+                                                , showTextData+                                                )++-- | An organized collection of a subreddit\'s widgets+data SubredditWidgets = SubredditWidgets+    { idCard       :: IDCardWidget+    , moderators   :: ModeratorsWidget+    , topbar       :: Seq Widget+    , sidebar      :: Seq Widget+    , topbarOrder  :: Seq WidgetID+    , sidebarOrder :: Seq WidgetID+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON SubredditWidgets where+    parseJSON = withObject "SubredditWidgets" $ \o -> do+        items :: Object <- o .: "items"+        layout <- o .: "layout"++        let lookupWidget :: FromJSON b => Text -> Parser b+            lookupWidget fld = maybe mempty parseJSON . (`HM.lookup` items)+                =<< layout .: fld++            lookupWidgets fld = fmap fromList+                . traverse parseJSON+                . mapMaybe (`HM.lookup` items)+                =<< (.: "order")+                =<< layout .: fld++        idCard <- lookupWidget "idCardWidget"+        moderators <- lookupWidget "moderatorWidget"+        topbar <- lookupWidgets "topbar"+        sidebar <- lookupWidgets "sidebar"+        topbarOrder <- (.: "order") =<< layout .: "topbar"+        sidebarOrder <- (.: "order") =<< layout .: "sidebar"+        pure SubredditWidgets { .. }++-- | Represents one of various kinds of widgets+data Widget+    = Buttons ButtonWidget+    | Calendar CalendarWidget+    | CommunityList CommunityListWidget+    | Custom CustomWidget+    | IDCard IDCardWidget+    | Images ImageWidget+    | Moderators ModeratorsWidget+    | Menu MenuWidget+    | PostFlair PostFlairWidget+    | Rules RulesWidget+    | TextArea TextAreaWidget+    deriving stock ( Show, Eq, Generic )++instance FromJSON Widget where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++instance ToJSON Widget where+    toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }++-- | A widget ID. These are usually prefixed with the type of widget it corresponds+-- to, e.g. @rules-2qh1i@ for a 'RulesWidget'+newtype WidgetID = WidgetID Text+    deriving stock ( Show, Generic )+    deriving ( Eq ) via CIText WidgetID++instance ToHttpApiData WidgetID where+    toQueryParam (WidgetID wid) = "widget_" <> wid++instance FromJSON WidgetID where+    parseJSON = withText "WidgetID" (breakOnType "widget")++instance ToJSON WidgetID where+    toJSON = String . toQueryParam++-- | The section in which certain 'Widget's appear+data WidgetSection+    = Topbar+    | Sidebar+    deriving stock ( Show, Eq, Generic )++instance ToHttpApiData WidgetSection where+    toUrlPiece = showTextData++-- | A \"short name\" for any widget. This name must be less than 30 characters+-- long+newtype ShortName = ShortName Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON, ToJSON )++-- | Smart constructor for 'ShortName's, which must be <= 30 characters long+mkShortName :: MonadThrow m => Text -> m ShortName+mkShortName t+    | T.length t > 30 =+        throwM $ OtherError "mkShortName: Name must be <= 30 characters long"+    | otherwise = pure $ coerce t++-- | Wrapper to parse a @HashMap WidgetID Widget@, discarding the ID keys+newtype WidgetList = WidgetList (Seq Widget)+    deriving stock ( Show, Generic )++instance FromJSON WidgetList where+    parseJSON = withObject "WidgetList" $ \o -> WidgetList+        <$> (getVals =<< o .: "items")++-- | Style options for an individual widget+data WidgetStyles = WidgetStyles+    { backgroundColor :: Maybe RGBText --+    , headerColor     :: Maybe RGBText+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON WidgetStyles where+    parseJSON = withObject "WidgetStyles" $ \o -> WidgetStyles+        <$> (maybe (pure Nothing) nothingTxtNull =<< o .: "backgroundColor")+        <*> (maybe (pure Nothing) nothingTxtNull =<< o .: "headerColor")++instance ToJSON WidgetStyles where+    toJSON = genericToJSON defaultOptions++-- | A widget containing buttons+data ButtonWidget = ButtonWidget+    { widgetID        :: Maybe WidgetID+    , shortName       :: ShortName+    , buttons         :: Seq Button+    , description     :: Body+    , descriptionHTML :: Maybe Body+    , styles          :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ButtonWidget where+    parseJSON = withWidgetKind ButtonType "ButtonWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = buttonWidgetModifier }++instance ToJSON ButtonWidget where+    toJSON = widgetToJSON buttonWidgetModifier ButtonType++buttonWidgetModifier :: Modifier+buttonWidgetModifier = \case+    "descriptionHTML" -> "descriptionHtml"+    s                 -> defaultWidgetModifier s++-- | An individual button in a 'ButtonWidget'+data Button+    = ImageButton ButtonImage+    | TextButton ButtonText+    deriving stock ( Show, Eq, Generic )++instance FromJSON Button where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++instance ToJSON Button where+    toJSON b = widgetToJSON defaultWidgetModifier buttonType b+      where+        buttonType = case b of+            ImageButton _ -> ImageType+            TextButton _  -> TextType++-- | Data for an 'ImageButton'+data ButtonImage = ButtonImage+    { text       :: ShortName+    , url        :: UploadURL+    , linkURL    :: URL+    , height     :: Int+    , width      :: Int+    , hoverState :: Maybe ButtonHover+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ButtonImage where+    parseJSON =+        genericParseJSON defaultOptions+                         { fieldLabelModifier = imageButtonDataModifier }++instance ToJSON ButtonImage where+    toJSON = genericToJSON defaultOptions+                           { fieldLabelModifier = imageButtonDataModifier+                           , omitNothingFields  = True+                           }++imageButtonDataModifier :: Modifier+imageButtonDataModifier = \case+    "linkURL" -> "linkUrl"+    s         -> s++-- | Data for a 'TextButton'+data ButtonText = ButtonText+    { text       :: ShortName+    , url        :: URL+    , color      :: RGBText+    , fillColor  :: Maybe RGBText+    , textColor  :: Maybe RGBText+    , hoverState :: Maybe ButtonHover+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ButtonText++instance ToJSON ButtonText where+    toJSON = genericToJSON defaultOptions { omitNothingFields = True }++-- | The state of the 'Button' when hovering over it+data ButtonHover+    = ImageButtonHover ImageHover+    | TextButtonHover TextHover+    deriving stock ( Show, Eq, Generic )++instance FromJSON ButtonHover where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++instance ToJSON ButtonHover where+    toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }++-- | The state of an 'ImageButton' when hovering over it+data ImageHover = ImageHover+    { url :: UploadURL, height :: Maybe Integer, width :: Maybe Integer }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ImageHover++instance ToJSON ImageHover where+    toJSON = widgetToJSON id ImageType++-- | The state of a 'TextButton' when hovering over it+data TextHover = TextHover+    { text      :: ShortName+    , color     :: Maybe RGBText+    , fillColor :: Maybe RGBText+    , textColor :: Maybe RGBText+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON TextHover++instance ToJSON TextHover where+    toJSON = widgetToJSON id TextType++-- | A widget representing a calendar+data CalendarWidget = CalendarWidget+    { widgetID         :: Maybe WidgetID+    , shortName        :: ShortName+    , googleCalendarID :: Text+    , configuration    :: CalendarConfig+    , requiresSync     :: Bool+    , styles           :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON CalendarWidget where+    parseJSON = withWidgetKind CalendarType "CalendarWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = calendarModifier }++instance ToJSON CalendarWidget where+    toJSON = widgetToJSON calendarModifier CalendarType++calendarModifier :: Modifier+calendarModifier = \case+    "googleCalendarID" -> "googleCalendarId"+    s                  -> defaultWidgetModifier s++-- | Configuration options for a 'CalendarWidget'+data CalendarConfig = CalendarConfig+    { -- | Between 1 and 50, defaulting to 10+      numEvents       :: Word+    , showDate        :: Bool+    , showDescription :: Bool+    , showLocation    :: Bool+    , showTime        :: Bool+    , showTitle       :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON CalendarConfig++instance ToJSON CalendarConfig++-- | A calendar config with default values+defaultCalendarConfig :: CalendarConfig+defaultCalendarConfig = CalendarConfig+    { numEvents       = 10+    , showDate        = False+    , showDescription = False+    , showLocation    = False+    , showTime        = False+    , showTitle       = False+    }++-- | A widget listing related subreddits+data CommunityListWidget = CommunityListWidget+    { widgetID    :: Maybe WidgetID+    , shortName   :: ShortName+    , communities :: Seq CommunityInfo+    , styles      :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON CommunityListWidget where+    parseJSON = withWidgetKind CommunityListType "CommunityListWidget"+        $ genericParseJSON defaultOptions { fieldLabelModifier }+      where+        fieldLabelModifier = \case+            "communities" -> "data"+            s             -> defaultWidgetModifier s++instance ToJSON CommunityListWidget where+    toJSON CommunityListWidget { .. } = object+        $ [ "shortName" .= shortName+            -- The @data@ field is not accepted in the same format as it is sent+          , "data" .= (communities <&> \CommunityInfo { name } -> name)+          , "kind" .= ("community-list" :: Text)+          ]+        <> foldMap pure (("styles" .=) <$> styles)++-- | Information about a single subreddit in a 'CommunityListWidget'. When+-- creating a new widget, only the @name@ field will be serialized+data CommunityInfo = CommunityInfo+    { name          :: SubredditName+    , subscribers   :: Maybe Integer+    , primaryColor  :: Maybe RGBText+    , iconURL       :: Maybe URL+    , communityIcon :: Maybe URL+      -- | If the authenticated user is subscribed to the subreddit+    , isSubscribed  :: Maybe Bool+    , isNSFW        :: Maybe Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON CommunityInfo where+    parseJSON = withObject "CommunityInfo" $ \o -> CommunityInfo+        <$> o .: "name"+        <*> o .: "subscribers"+        <*> (nothingTxtNull =<< o .: "primaryColor")+        <*> (nothingTxtNull =<< o .: "iconUrl")+        <*> (nothingTxtNull =<< o .: "communityIcon")+        <*> o .: "isSubscribed"+        <*> o .:? "isNSFW"++instance ToJSON CommunityInfo where+    toJSON CommunityInfo { name } = object [ "name" .= name ]++-- | Convenience function for creating a new 'CommunityInfo', where+-- all but one of the fields should be @Nothing@+mkCommunityInfo :: SubredditName -> CommunityInfo+mkCommunityInfo name = CommunityInfo+    { name+    , subscribers   = Nothing+    , primaryColor  = Nothing+    , iconURL       = Nothing+    , communityIcon = Nothing+    , isSubscribed  = Nothing+    , isNSFW        = Nothing+    }++-- | A custom widget+data CustomWidget = CustomWidget+    { widgetID      :: Maybe WidgetID+    , shortName     :: ShortName+    , text          :: Body+    , imageData     :: Seq ImageData+      -- | Should be between 50 and 500+    , height        :: Int+      -- | Should be @Nothing@ when creating a new widget+    , textHTML      :: Maybe Body+    , css           :: Maybe Text+    , stylesheetURL :: Maybe URL+    , styles        :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON CustomWidget where+    parseJSON = withWidgetKind CustomType "CustomWidget" customP+      where+        customP (Object o) = CustomWidget <$> o .: "id"+            <*> o .: "shortName"+            <*> o .: "text"+            <*> o .: "imageData"+            <*> o .: "height"+            <*> o .: "textHtml"+            <*> (nothingTxtNull =<< o .: "css")+            <*> o .: "stylesheetUrl"+            <*> o .: "styles"+        customP _          = mempty++instance ToJSON CustomWidget where+    toJSON CustomWidget { .. } = object+        $ [ "shortName" .= shortName+          , "text" .= text+          , "imageData" .= imageData+          , "height" .= height+            -- Reddit won't accept empty CSS, so this will prevent an error+            -- in case the @css@ field is empty+          , "css" .= fromMaybe "/**/" css+          , "kind" .= ("custom" :: Text)+          ]+        <> catMaybes [ ("stylesheetUrl" .=) <$> stylesheetURL+                     , ("styles" .=) <$> styles+                     ]++-- | Image data that belongs to a 'CustomWidget'+data ImageData = ImageData+    { name   :: Name+    , height :: Int+    , width  :: Int+      -- | This url must point to an image hosted by Reddit+    , url    :: UploadURL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ImageData++instance ToJSON ImageData++-- | An ID card displaying information about the subreddit+data IDCardWidget = IDCardWidget+    { widgetID              :: Maybe WidgetID+    , shortName             :: ShortName+    , description           :: Body+    , subscribersText       :: Text+    , currentlyViewingText  :: Text+    , subscribersCount      :: Maybe Integer+    , currentlyViewingCount :: Maybe Integer+    , styles                :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON IDCardWidget where+    parseJSON = withWidgetKind IDCardType "IDCardWidget" idCardP+      where+        idCardP (Object o) = IDCardWidget <$> o .: "id"+            <*> o .: "shortName"+            -- This field is missing after updates+            <*> (fromMaybe mempty <$> optional (o .: "description"))+            <*> o .: "subscribersText"+            <*> o .: "currentlyViewingText"+            <*> o .:? "subscribersCount"+            <*> o .:? "currentlyViewingCount"+            <*> o .: "styles"+        idCardP _          = mempty++instance ToJSON IDCardWidget where+    toJSON = widgetToJSON defaultWidgetModifier IDCardType++-- | A widget composed of various 'Image's+data ImageWidget = ImageWidget+    { widgetID  :: Maybe WidgetID+    , shortName :: ShortName+    , images    :: Seq Image+    , styles    :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ImageWidget where+    parseJSON = withWidgetKind ImageType "ImageWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = imageWidgetModifier }++instance ToJSON ImageWidget where+    toJSON = widgetToJSON imageWidgetModifier ImageType++imageWidgetModifier :: Modifier+imageWidgetModifier = \case+    "images" -> "data"+    s        -> defaultWidgetModifier s++-- | An individual image in an 'ImageWidget'+data Image = Image+    { width   :: Integer+    , height  :: Integer+      -- | The reddit-hosted image URL+    , url     :: UploadURL+      -- | The link that is followed when clicking on the image+    , linkURL :: Maybe URL+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Image where+    parseJSON = genericParseJSON --+        defaultOptions { fieldLabelModifier = imageModifier }++instance ToJSON Image where+    toJSON =+        genericToJSON defaultOptions { fieldLabelModifier = imageModifier }++imageModifier :: Modifier+imageModifier = \case+    "linkURL" -> "linkUrl"+    s         -> s++-- | A widget representing a menu+data MenuWidget =+    MenuWidget { widgetID :: Maybe WidgetID, children :: Seq MenuChild }+    deriving stock ( Show, Eq, Generic )++instance FromJSON MenuWidget where+    parseJSON = withWidgetKind MenuType "MenuWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = menuWidgetModifier }++instance ToJSON MenuWidget where+    toJSON = widgetToJSON menuWidgetModifier MenuType++menuWidgetModifier :: Modifier+menuWidgetModifier = \case+    "children" -> "data"+    s          -> defaultWidgetModifier s++-- | A child widget in a 'MenuWidget'+data MenuChild+    = SubmenuChild Submenu+    | MenuLinkChild MenuLink+    deriving stock ( Show, Eq, Generic )++instance FromJSON MenuChild where+    parseJSON =+        genericParseJSON defaultOptions { sumEncoding = UntaggedValue }++instance ToJSON MenuChild where+    toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }++-- | A submenu child in a 'MenuWidget' which contains 'MenuLink's+data Submenu = Submenu { children :: Seq MenuLink, text :: Text }+    deriving stock ( Show, Eq, Generic )++instance FromJSON Submenu++instance ToJSON Submenu++-- | A link in a 'MenuWidget' or 'Submenu'+data MenuLink = MenuLink { text :: Text, url :: URL }+    deriving stock ( Show, Eq, Generic )++instance FromJSON MenuLink++instance ToJSON MenuLink++-- | A widget listing the moderators of the subreddit. This widget cannot be+-- created. It can be updated by modifying the @styles@ field only+data ModeratorsWidget = ModeratorsWidget+    { widgetID  :: Maybe WidgetID+    , mods      :: Seq ModInfo+    , totalMods :: Maybe Int+    , styles    :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModeratorsWidget where+    parseJSON = withWidgetKind ModeratorsType "ModeratorsWidget" modsP+      where+        modsP (Object o) = ModeratorsWidget <$> o .: "id"+            -- Apparently this field is occasionally missing from updated+            -- @ModeratorsWidget@s+            <*> fromOptional o "mods"+            -- This one too+            <*> optional (o .: "totalMods")+            <*> o .: "styles"+        modsP _          = mempty++instance ToJSON ModeratorsWidget where+    toJSON ModeratorsWidget { .. } = object+        $ [ "kind" .= ModeratorsType ]+        <> foldMap pure (("styles" .=) <$> styles)++-- | Information about a moderator as displayed in a 'ModeratorsWidget'+data ModInfo = ModInfo+    { name                 :: Username+    , flairText            :: Maybe FlairText+    , flairTextColor       :: Maybe ForegroundColor+    , flairBackgroundColor :: Maybe RGBText+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON ModInfo where+    parseJSON = withObject "ModInfo" $ \o -> ModInfo <$> o .: "name"+        <*> (maybe (pure Nothing) nothingTxtNull =<< o .:? "authorFlairText")+        <*> (maybe (pure Nothing) nothingTxtNull+             =<< o .:? "authorFlairTextColor")+        <*> (maybe (pure Nothing) nothingTxtNull+             =<< o .:? "authorFlairBackgroundColor")++instance ToJSON ModInfo where+    toJSON = genericToJSON defaultOptions+                           { fieldLabelModifier --+                           , omitNothingFields  = True+                           }+      where+        fieldLabelModifier = \case+            "flairText" -> "authorFlairText"+            "flairTextColor" -> "authorFlairTextColor"+            "flairBackgroundColor" -> "authorFlairBackgroundColor"+            s -> s++-- | A widget listing flair choices for submissions. When creating a new widget,+-- the 'FlairID's in the @order@ field must be valid template IDs for the given+-- subreddit. Existing flair templates can be obtained with+-- 'Network.Reddit.Subreddit.getSubmissionFlairTemplates', which can+-- then be mapped over to obtain the IDs. Once the flair IDs have been obtained,+-- 'mkPostFlairWidget' can be used to construct a widget with default values for+-- most fields+data PostFlairWidget = PostFlairWidget+    { widgetID  :: Maybe WidgetID+    , shortName :: ShortName+      -- | A container of 'FlairID's corresponding to the flair+      -- templates listed in the widget. Use this field when+      -- updating or creating 'PostFlairWidget's+    , order     :: Seq FlairID+      -- | A mapping of submission flair template IDs to+      -- brief information on each one. This field is /not/+      -- serialized when creating a new 'PostFlairWidget' or+      -- when updating an existing one, and can be left empty+      -- in those cases+    , templates :: HashMap FlairID PostFlairInfo+    , display   :: PostFlairWidgetDisplay+    , styles    :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON PostFlairWidget where+    parseJSON = withWidgetKind PostFlairType "PostFlairWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = defaultWidgetModifier }++instance ToJSON PostFlairWidget where+    toJSON PostFlairWidget { .. } = object+        $ [ "id" .= widgetID+          , "shortName" .= shortName+          , "order" .= order+          , "display" .= display+          , "kind" .= ("post-flair" :: Text)+          ]+        <> foldMap pure (("styles" .=) <$> styles)++-- | Make a new 'PostFlairWidget' with default values for most fields+mkPostFlairWidget :: ShortName -> Seq FlairID -> PostFlairWidget+mkPostFlairWidget shortName order = PostFlairWidget+    { widgetID  = Nothing+    , templates = mempty+    , display   = ListDisplay+    , styles    = Nothing+    , ..+    }++-- | Information about submission flair templates in a 'PostFlairWidget'+data PostFlairInfo = PostFlairInfo+    { templateID      :: FlairID+    , text            :: Text+    , textColor       :: ForegroundColor+    , backgroundColor :: RGBText+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON PostFlairInfo where+    parseJSON =+        genericParseJSON defaultOptions+                         { fieldLabelModifier = postFlairInfoModifier }++postFlairInfoModifier :: Modifier+postFlairInfoModifier = \case+    "templateID" -> "templateId"+    s            -> s++-- | The display orientation for 'PostFlairWidget's+data PostFlairWidgetDisplay+    = CloudDisplay+    | ListDisplay+    deriving stock ( Show, Eq, Generic )++instance FromJSON PostFlairWidgetDisplay where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = postFlairWidgetModifier }++instance ToJSON PostFlairWidgetDisplay where+    toJSON = genericToJSON --+        defaultOptions { constructorTagModifier = postFlairWidgetModifier }++postFlairWidgetModifier :: Modifier+postFlairWidgetModifier = \case+    "CloudDisplay" -> "cloud"+    "ListDisplay"  -> "list"+    _              -> mempty++-- | A widget listing subreddit 'SubredditRule's. The @rules@ field cannot be+-- updated through widget endpoints, and are excluded during serialization+data RulesWidget = RulesWidget+    { widgetID  :: Maybe WidgetID+    , shortName :: ShortName+    , rules     :: Seq SubredditRule+    , display   :: RulesDisplay+    , styles    :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON RulesWidget where+    parseJSON = withWidgetKind RulesType "RulesWidget" rulesP+      where+        rulesP (Object o) = RulesWidget <$> o .: "id"+            <*> o .: "shortName"+            -- This field may be missing after updating the widget+            <*> fromOptional o "data"+            <*> o .: "display"+            <*> o .: "styles"+        rulesP _          = mempty++instance ToJSON RulesWidget where+    toJSON RulesWidget { .. } =+        object [ "id" .= widgetID+               , "shortName" .= shortName+               , "display" .= display+               , "styles" .= styles+               , "kind" .= ("subreddit-rules" :: Text)+               ]++-- | Display style for a 'RulesWidget'+data RulesDisplay+    = FullDisplay+    | CompactDisplay+    deriving stock ( Show, Eq, Generic )++instance FromJSON RulesDisplay where+    parseJSON = genericParseJSON --+        defaultOptions { constructorTagModifier = rulesDisplayModifier }++instance ToJSON RulesDisplay where+    toJSON = genericToJSON --+        defaultOptions { constructorTagModifier = rulesDisplayModifier }++rulesDisplayModifier :: Modifier+rulesDisplayModifier = \case+    "FullDisplay"    -> "full"+    "CompactDisplay" -> "compact"+    _                -> mempty++-- | A widget composed of text. See 'mkTextAreaWidget' for constructing a new+-- widget+data TextAreaWidget = TextAreaWidget+    { widgetID  :: Maybe WidgetID+    , shortName :: ShortName+      -- | Markdown-formatted+    , text      :: Body+      -- | This is present in existing widgets, but should be+      -- left blank when creating a new one+    , textHTML  :: Maybe Body+    , styles    :: Maybe WidgetStyles+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON TextAreaWidget where+    parseJSON = withWidgetKind TextAreaType "TextAreaWidget"+        $ genericParseJSON defaultOptions+                           { fieldLabelModifier = textWidgetModifier }++instance ToJSON TextAreaWidget where+    toJSON = widgetToJSON textWidgetModifier TextAreaType++-- | Create a new 'TextAreaWidget', with default values for most fields+mkTextAreaWidget :: ShortName -> Body -> TextAreaWidget+mkTextAreaWidget shortName text = TextAreaWidget+    { widgetID = Nothing --+    , textHTML = Nothing+    , styles   = Nothing+    , ..+    }++textWidgetModifier :: Modifier+textWidgetModifier = \case+    "textHTML" -> "textHtml"+    s          -> defaultWidgetModifier s++-- Insert the @kind@ field into some JSON widget, while taking advantage of generic+-- @ToJSON@ deriving. An alternative would be to retain the field during encoding/+-- decoding . However, the user can only choose a single kind in each case+-- (e.g. a @ButtonWidget@ will always have the kind \"button\"), so that is perhaps+-- not the best choice as it would allow the construction of invalid widget values+widgetToJSON :: (Generic a, GToJSON' Value Zero (Rep a))+             => Modifier+             -> WidgetType+             -> a+             -> Value+widgetToJSON fieldLabelModifier ty x = case genericTo x of+    Object o -> Object $ HM.insert "kind" (toJSON ty) o+    v        -> v+  where+    genericTo = genericToJSON defaultOptions+                              { fieldLabelModifier+                              , omitNothingFields  = True+                              , sumEncoding        = UntaggedValue+                              }++defaultWidgetModifier :: Modifier+defaultWidgetModifier = \case+    "widgetID" -> "id"+    s          -> s++-- Parses a container of values that may be missing from the JSON, in which case+-- it returns @mempty@ as a default value+fromOptional+    :: (FromJSON (Item b), IsList b, Monoid b) => Object -> Text -> Parser b+fromOptional o fld = maybe mempty fromList <$> optional (o .: fld)++withWidgetKind+    :: WidgetType -> [Char] -> (Value -> Parser a) -> Value -> Parser a+withWidgetKind ty name f = withObject name $ \o -> do+    guard . (== ty) =<< o .: "kind"+    f $ Object o++data WidgetType+    = ImageType+    | TextType+    | ButtonType+    | CalendarType+    | CommunityListType+    | CustomType+    | IDCardType+    | MenuType+    | ModeratorsType+    | PostFlairType+    | RulesType+    | TextAreaType+    deriving stock ( Eq )++instance ToJSON WidgetType where+    toJSON = String . typeTag+      where+        typeTag = \case+            ImageType         -> "image"+            TextType          -> "text"+            ButtonType        -> "button"+            CalendarType      -> "calendar"+            CommunityListType -> "community-list"+            CustomType        -> "custom"+            IDCardType        -> "id-card"+            MenuType          -> "menu"+            ModeratorsType    -> "moderators"+            PostFlairType     -> "post-flair"+            RulesType         -> "subreddit-rules"+            TextAreaType      -> "textarea"++instance FromJSON WidgetType where+    parseJSON = withText "WidgetType" $ \case+        "image"           -> pure ImageType+        "text"            -> pure TextType+        "button"          -> pure ButtonType+        "calendar"        -> pure CalendarType+        "community-list"  -> pure CommunityListType+        "custom"          -> pure CustomType+        "id-card"         -> pure IDCardType+        "menu"            -> pure MenuType+        "moderators"      -> pure ModeratorsType+        "post-flair"      -> pure PostFlairType+        "subreddit-rules" -> pure RulesType+        "textarea"        -> pure TextAreaType+        _                 -> mempty
+ src/Network/Reddit/Types/Wiki.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : Network.Reddit.Types.Wiki+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Types.Wiki+    ( WikiPage(..)+    , WikiRevisionID(WikiRevisionID)+    , WikiPageName+    , mkWikiPageName+    , WikiPageListing+    , WikiRevision(..)+    , WikiPageSettings(..)+    , WikiPermLevel(..)+    ) where++import           Data.Aeson+                 ( (.:)+                 , (.:?)+                 , Array+                 , FromJSON(..)+                 , withArray+                 , withObject+                 , withScientific+                 , withText+                 )+import           Data.Coerce                   ( coerce )+import           Data.Sequence                 ( Seq )+import           Data.Text                     ( Text )+import qualified Data.Text                     as T+import           Data.Time                     ( UTCTime )+import           Data.Traversable              ( for )++import           GHC.Exts                      ( IsList(toList, fromList) )+import           GHC.Generics                  ( Generic )++import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Internal++import           Web.HttpApiData               ( ToHttpApiData(..) )++-- | An individual subreddit wikipage along with its revision information+data WikiPage = WikiPage+    { -- | The page content, as markdown+      content      :: Body+    , contentHTML  :: Body+    , revisionBy   :: Username+    , revisionDate :: UTCTime+      -- | Indicates whether the authenticated user+      -- can revise this particular wikipage+    , mayRevise    :: Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON WikiPage where+    parseJSON = withKind WikiPageKind "WikiPage" $ \o -> WikiPage+        <$> o .: "content_md"+        <*> o .: "content_html"+        <*> ((.: "name") =<< (.: "data") =<< o .: "revision_by")+        <*> (integerToUTC <$> o .: "revision_date")+        <*> o .: "may_revise"++-- | The name of an individual wiki page. The name forms part of the URL, and+-- should not contain spaces or uppercase characters+newtype WikiPageName = WikiPageName Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, FromJSON, ToHttpApiData )++-- | Smart constructor for 'WikiPageName's. Lowercases the contained text, and+-- replaces each space with a single underscore+mkWikiPageName :: Text -> WikiPageName+mkWikiPageName = coerce . T.toLower . T.replace " " "_"++-- | Information regarding a single 'WikiPage' revision+data WikiRevision = WikiRevision+    { revisionID :: WikiRevisionID+    , page       :: WikiPageName+    , timestamp  :: UTCTime+    , author     :: Username+      -- | The reason for editing the page, if any+    , reason     :: Maybe Text+      -- | If the revision has been hidden+    , hidden     :: Maybe Bool+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON WikiRevision where+    parseJSON = withObject "WikiRevision" $ \o -> WikiRevision <$> o .: "id"+        <*> o .: "page"+        <*> (integerToUTC <$> o .: "timestamp")+        <*> ((.: "name") =<< (.: "data") =<< o .: "author")+        <*> (maybe (pure Nothing) nothingTxtNull =<< o .:? "reason")+        <*> o .:? "revision_hidden"++-- The endpoints that list revisions are a @Listing@, but there are no additional+-- options that can be passed to them. Giving this dummy instance at least allows+-- using a @Listing ... WikiRevision@ with existing convenience functions+instance Paginable WikiRevision where+    type PaginateOptions WikiRevision = ()++    type PaginateThing WikiRevision = WikiRevisionID++    defaultOpts = ()++    optsToForm _ = mempty++    getFullname WikiRevision { revisionID } = revisionID++-- | ID for a wikipage revision+newtype WikiRevisionID = WikiRevisionID Text+    deriving stock ( Show, Generic )+    deriving newtype ( Eq, ToHttpApiData )++instance FromJSON WikiRevisionID where+    parseJSON = withText "WikiRevisionID" (breakOnType "WikiRevision")++instance Thing WikiRevisionID where+    fullname (WikiRevisionID r) = "WikiRevision_" <> r++-- | Wrapper for listings of @WikiPage@s, which have their own @RedditKind@+newtype WikiPageListing = WikiPageListing (Seq WikiPageName)+    deriving stock ( Show, Generic )++instance FromJSON WikiPageListing where+    parseJSON = withKind @Array WikiPageListingKind "WikiPageListing"+        $ fmap (WikiPageListing . fromList) . traverse parseJSON . toList++-- | The settings that moderators have configured for a single 'WikiPage'+data WikiPageSettings = WikiPageSettings+    { permlevel      :: WikiPermLevel+    , listed         :: Bool+    , allowedEditors :: Seq Username+    }+    deriving stock ( Show, Eq, Generic )++instance FromJSON WikiPageSettings where+    parseJSON = withKind WikiPageSettingsKind "WikiPageSettings" $ \o ->+        WikiPageSettings <$> o .: "permlevel"+        <*> o .: "listed"+        <*> (fromList <$> (editorsP =<< o .: "editors"))+      where+        editorsP = withArray "[User]" $ \as ->+            for (toList as) . withObject "User" $ \o -> (.: "name")+            =<< o .: "data"++-- | Editing permission level configured for a single 'WikiPage'+data WikiPermLevel+    = FollowWikiSettings+    | ApprovedEditorsOnly+    | ModEditsOnly+    deriving stock ( Show, Eq, Generic, Ord )++instance FromJSON WikiPermLevel where+    parseJSON = withScientific "WikiPermLevel" $ \case+        0.0 -> pure FollowWikiSettings+        1.0 -> pure ApprovedEditorsOnly+        2.0 -> pure ModEditsOnly+        _   -> mempty++instance ToHttpApiData WikiPermLevel where+    toQueryParam = \case+        FollowWikiSettings  -> "0"+        ApprovedEditorsOnly -> "1"+        ModEditsOnly        -> "2"
+ src/Network/Reddit/User.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.User+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Actions related to users, excluding the currently logged-in one. For actions+-- on the current account, see "Network.Reddit.Me"+--+module Network.Reddit.User+    (  -- * Actions+      isUsernameAvailable+    , getUser+    , getUserTrophies+    , getUserComments+    , getUserSubmissions+    , getUserUpvoted+    , getUserDownvoted+    , getUserHidden+    , getUserOverview+    , getUserGilded+    , getUserSaved+    , getUserMultireddits+      -- * User @Listing@s and summaries+      -- | These actions return @Listing@s for special user subreddits,+      -- user accounts, or 'UserSummary's for existing user IDs+    , getNewUsers+    , getPopularUsers+    , searchUsers+    , getUserSummaries+    , getUserSummary+      -- * Types+    , module M+    ) where++import           Control.Monad.Catch              ( MonadThrow(throwM) )++import           Data.Aeson                       ( FromJSON )+import qualified Data.Foldable                    as F+import           Data.Generics.Wrapped            ( wrappedTo )+import           Data.List.Split                  ( chunksOf )+import           Data.Sequence                    ( Seq((:<|)) )+import           Data.Text                        ( Text )++import           Lens.Micro++import           Network.Reddit.Internal+import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Account     as M+                 ( AcceptPMs(..)+                 , Account(Account)+                 , AccountSearchOpts(AccountSearchOpts)+                 , AccountSearchSort(..)+                 , Friend(Friend)+                 , Karma(Karma)+                 , MediaPreference(..)+                 , Preferences(Preferences)+                 , Trophy(Trophy)+                 , UserID(UserID)+                 , UserSummary(UserSummary)+                 , Username+                 , mkUsername+                 )+import           Network.Reddit.Types.Comment+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) )+import           Web.HttpApiData                  ( ToHttpApiData(..) )++-- | Check if a 'Username' is available for use+isUsernameAvailable :: MonadReddit m => Username -> m Bool+isUsernameAvailable uname =+    runAction defaultAPIAction+              { requestData  = mkTextFormData [ ("user", toQueryParam uname) ]+              , pathSegments = [ "api", "username_available.json" ]+              , needsAuth    = False+              }++-- | Get information about another user+getUser :: MonadReddit m => Username -> m Account+getUser uname =+    runAction defaultAPIAction+              { pathSegments = [ "user", toUrlPiece uname, "about" ] }++-- | Get a user\'s 'Trophy's+getUserTrophies :: MonadReddit m => Username -> m (Seq Trophy)+getUserTrophies uname = runAction @TrophyList r <&> wrappedTo+  where+    r = defaultAPIAction+        { pathSegments = [ "user", toUrlPiece uname, "trophies" ] }++-- | Get a 'Listing' of a user\'s 'Comment's+getUserComments :: MonadReddit m+                => Username+                -> Paginator CommentID Comment+                -> m (Listing CommentID Comment)+getUserComments = userItems "comments"++-- | Get a 'Listing' of a user\'s 'Submission's+getUserSubmissions :: MonadReddit m+                   => Username+                   -> Paginator SubmissionID Submission+                   -> m (Listing SubmissionID Submission)+getUserSubmissions = userItems "submitted"++getUserUpvoted, getUserDownvoted, getUserGilded+    :: MonadReddit m+    => Username+    -> Paginator ItemID Item+    -> m (Listing ItemID Item)++-- | Get 'Item's that a user has upvoted. You must be authorized to access this,+-- or an exception will be raised+getUserUpvoted = userItems "upvoted"++-- | Get 'Item's that a user has upvoted. You must be authorized to access this,+-- or an exception will be raised+getUserDownvoted = userItems "downvoted"++getUserHidden, getUserOverview, getUserSaved+    :: MonadReddit m+    => Username+    -> Paginator ItemID Item+    -> m (Listing ItemID Item)++-- | Get the 'Item's that a user has gilded+getUserGilded = userItems "gilded"++-- | Get 'Item's that a user has hidden. You must be authorized to access this,+-- or an exception will be raised+getUserHidden = userItems "hidden"++-- | Get an overview of a user\'s 'Comment's and 'Submission's+getUserOverview = userItems "overview"++-- | Get the 'Item's that a user has saved. You must be authorized to access this,+-- or an exception will be raised+getUserSaved = userItems "saved"++userItems :: (MonadReddit m, Thing t, Paginable a, FromJSON a, FromJSON t)+          => Text+          -> Username+          -> Paginator t a+          -> m (Listing t a)+userItems path uname paginator =+    runAction defaultAPIAction+              { pathSegments = [ "user", toUrlPiece uname, path ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get the public 'Multireddit's belonging to the given user+getUserMultireddits :: MonadReddit m => Username -> m (Seq Multireddit)+getUserMultireddits uname =+    runAction defaultAPIAction+              { pathSegments = [ "api", "multi", "user", toUrlPiece uname ] }++-- | Get a @Listing@ of special user subreddits, sorted on creation date (newest+-- first)+getNewUsers :: MonadReddit m+            => Paginator SubredditID Subreddit+            -> m (Listing SubredditID Subreddit)+getNewUsers paginator =+    runAction defaultAPIAction+              { pathSegments = [ "users", "new" ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get a @Listing@ of special user subreddits, sorted on popularity+getPopularUsers :: MonadReddit m+                => Paginator SubredditID Subreddit+                -> m (Listing SubredditID Subreddit)+getPopularUsers paginator =+    runAction defaultAPIAction+              { pathSegments = [ "users", "new" ]+              , requestData  = paginatorToFormData paginator+              }++-- | Get a @Listing@ of user profiles whose titles and descriptions which match+-- the given @query@+searchUsers :: MonadReddit m+            => Text+            -> Paginator UserID Account+            -> m (Listing UserID Account)+searchUsers query paginator =+    runAction defaultAPIAction+              { pathSegments = [ "users", "search" ]+              , requestData  =+                    WithForm $ mkTextForm [ ("q", query) ] <> toForm paginator+              }++-- | Get a brief 'UserSummary' for each valid 'UserID'. Note that Reddit silently+-- ignores invalid IDs, so the output may be shorted than the input container+getUserSummaries+    :: (MonadReddit m, Foldable t) => t UserID -> m (Seq UserSummary)+getUserSummaries uids = mconcat <$> traverse mkAction (chunked uids)+  where+    chunked = chunksOf apiRequestLimit . F.toList++    mkAction ids = runAction @UserSummaryList r <&> wrappedTo+      where+        r = defaultAPIAction+            { pathSegments = [ "api", "user_data_by_account_ids" ]+            , requestData  = mkTextFormData [ ("ids", fullname ids) ]+            }++-- | Get the 'UserSummary' for a single user ID+getUserSummary :: MonadReddit m => UserID -> m UserSummary+getUserSummary uid = getUserSummaries [ uid ] >>= \case+    us :<| _ -> pure us+    _        -> throwM $ InvalidResponse "getUserSummary: No such user"
+ src/Network/Reddit/Utils.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Network.Reddit.Utils+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+module Network.Reddit.Utils+    ( bshow+    , defaultAPIAction+    , joinPathSegments+    , writeUA+    , emptyPaginator+    , paginatorToFormData+    , apiRequestLimit+    , mkTextForm+    , mkTextFormData+    , submissionIDFromURL+    , subAPIPath+    , subAboutPath+    , textObject+    , textEncode+    , joinPerms+    , splitPath+    , splitURL+    , catchEmptyListing+    ) where++import           Control.Monad.Catch             ( MonadCatch(catch)+                                                 , MonadThrow(throwM)+                                                 )++import           Data.Aeson                      ( eitherDecode )+import           Data.ByteString                 ( ByteString )+import qualified Data.ByteString.Char8           as C8+import           Data.Containers.ListUtils       ( nubOrd )+import qualified Data.Foldable                   as F+import           Data.Generics.Wrapped           ( wrappedFrom, wrappedTo )+import           Data.List                       ( (\\) )+import qualified Data.Text                       as T+import           Data.Text                       ( Text )+import qualified Data.Text.Encoding              as T++import           Network.Reddit.Types+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Subreddit++import           URI.ByteString+                 ( Authority(..)+                 , URIRef(URI, uriPath, uriAuthority)+                 , laxURIParserOptions+                 , parseURI+                 )++import           Web.FormUrlEncoded              ( ToForm(toForm) )+import           Web.HttpApiData                 ( ToHttpApiData(..) )++-- | Default settings for an 'APIAction' - a GET request with no path, form+-- data, or query string, and which requires authentication headers+defaultAPIAction :: APIAction a+defaultAPIAction = APIAction+    { method          = GET+    , pathSegments    = mempty+    , requestData     = NoData+    , needsAuth       = True+    , followRedirects = True+    , rawJSON         = True+    , checkResponse   = \_ _ -> pure ()+    }++-- | Join a collection of 'PathSegment's, with a leading slash+joinPathSegments :: Foldable t => t PathSegment -> ByteString+joinPathSegments = T.encodeUtf8 . foldr (\a b -> "/" <> a <> b) mempty++-- | Convert a 'UserAgent' to its textual value+writeUA :: UserAgent -> ByteString+writeUA UserAgent { .. } = T.encodeUtf8 withInfo+  where+    withInfo = mconcat [ info, " ", "(", "by ", author, ")" ]++    info     = T.intercalate ":" [ platform, appID, version ]++paginatorToFormData :: (Thing t, Paginable a) => Paginator t a -> WithData+paginatorToFormData = WithForm . toForm++-- | An empty, default 'Paginator'. Includes the default 'PaginateOptions' for+-- the type @a@+emptyPaginator :: forall t a. Paginable a => Paginator t a+emptyPaginator = Paginator+    { before   = Nothing+    , after    = Nothing+    , limit    = 25+    , showAll  = False+    , srDetail = False+    , opts     = defaultOpts @a+    }++-- | Convert @(Text, Text)@ pairs into a URL-encoded 'Form'+mkTextFormData :: [(Text, Text)] -> WithData+mkTextFormData = WithForm . mkTextForm++apiRequestLimit :: Num n => n+apiRequestLimit = 100++-- | Parse a 'SubmissionID' from a Reddit URL+submissionIDFromURL :: MonadThrow m => Text -> m SubmissionID+submissionIDFromURL url = case parsed of+    Left _           -> invalidURL "Invalid URL provided"+    Right URI { .. }+        | Just Authority { authorityHost } <- uriAuthority    --+            -> case wrappedTo authorityHost of+                host+                    | host `elem` [ "reddit.com", "www.reddit.com" ]    --+                        -> case splitPath uriPath of+                            [ "gallery", sid ] -> pure $ mkID sid+                            ("comments" : sid : _) -> pure $ mkID sid+                            ("r" : _ : "comments" : sid : _) ->+                                pure $ mkID sid+                            _ -> invalidURL+                                $ mconcat [ "Path must be one of "+                                          , "/r/<SUBREDDIT>/comments/<ID>/<NAME>/, "+                                          , "/gallery/<ID>, or /comments/<ID>/"+                                          ]++                    | host == "redd.it" -> case splitPath uriPath of+                        [ sid ] -> pure $ mkID sid+                        _       -> invalidURL "Path may only contain /<ID>"++                    | otherwise -> invalidURL "Unrecognized host"+        | otherwise -> invalidURL "URL authority not present or unrecognized"+  where+    parsed     = parseURI laxURIParserOptions $ T.encodeUtf8 url++    invalidURL = throwM . InvalidRequest++    mkID       = wrappedFrom . T.decodeUtf8++-- | Get the API path for a subreddit given its 'SubredditName'+subAPIPath :: SubredditName -> PathSegment -> [PathSegment]+subAPIPath sname path = [ "r", toUrlPiece sname, "api", path ]++-- | Get the \"about\" path for a subreddit given its 'SubredditName'+subAboutPath :: SubredditName -> PathSegment -> [PathSegment]+subAboutPath sname path = [ "r", toUrlPiece sname, "about", path ]++-- | Turn a container of permissions into a string Reddit uses to configure+-- permissions for different roles. Included permissions are prefixed with+-- \"+\", omitted ones with \"-\"+--+-- Can be used with 'ModPermission's and 'LivePermission's+joinPerms+    :: (Foldable t, Ord a, Enum a, Bounded a, ToHttpApiData a) => t a -> Text+joinPerms perms = T.intercalate ","+    $ mconcat [ [ "-all" ]+              , prefixPerm "-" <$> omitted+              , prefixPerm "+" <$> included+              ]+  where+    included     = nubOrd $ F.toList perms++    omitted      = [ minBound .. ] \\ included++    prefixPerm t = (t <>) . toQueryParam++-- | Split a URL path+splitPath :: ByteString -> [ByteString]+splitPath = drop 1 . C8.split '/'++-- | Get the host and path segments from a URL+splitURL :: MonadThrow m => URL -> m (ByteString, [PathSegment])+splitURL url = case parseURI laxURIParserOptions $ T.encodeUtf8 url of+    Right URI { .. }+        | Just Authority { authorityHost } <- uriAuthority --+            ->+            pure (wrappedTo authorityHost, T.decodeUtf8 <$> splitPath uriPath)+        | otherwise -> invalidURL+    Left _           -> invalidURL+  where+    invalidURL = throwM $ InvalidResponse "splitURL: Couldn't parse URL"++-- | HACK+-- For some reason, if a subreddit does not exist, Reddit returns an+-- empty @Listing@ instead of returning 404+catchEmptyListing :: MonadReddit m => m a -> m a+catchEmptyListing action = catch @_ @APIException action $ \case+    e@(JSONParseError _ body) -> case eitherDecode @(Listing () ()) body of+        Right _ -> throwM . ErrorWithStatus+            $ StatusMessage 404 "Resource does not exist"+        Left _  -> throwM e+    e -> throwM e
+ tests/Main.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE TypeApplications #-}++module Main where++import           Data.Aeson                       ( eitherDecodeFileStrict' )+import           Data.Either                      ( isRight )+import           Data.Sequence                    ( Seq )++import           Network.Reddit.Types+import           Network.Reddit.Types.Account+import           Network.Reddit.Types.Comment+import           Network.Reddit.Types.Emoji+import           Network.Reddit.Types.Flair+import           Network.Reddit.Types.Live+import           Network.Reddit.Types.Message+import           Network.Reddit.Types.Moderation+import           Network.Reddit.Types.Multireddit+import           Network.Reddit.Types.Submission+import           Network.Reddit.Types.Subreddit+import           Network.Reddit.Types.Widget+import           Network.Reddit.Types.Wiki++import           Test.Hspec++main :: IO ()+main = sequence_ [ decodeAccountTypes+                 , decodeCommentTypes+                 , decodeSubmissionTypes+                 , decodeSubredditTypes+                 , decodeMessageTypes+                 , decodeModerationTypes+                 , decodeFlairTypes+                 , decodeWikiTypes+                 , decodeWidgetTypes+                 , decodeEmojiTypes+                 , decodeLiveTypes+                 ]++{- HLINT ignore "Redundant do"-}+decodeAccountTypes :: IO ()+decodeAccountTypes = hspec $ do+    describe "Network.Reddit.Types.Account" $ do+        it "decodes Account" $ do+            userAccount <- eitherDecodeFileStrict' @Account+                $ typesDataPath "user-account.json"+            userAccount `shouldSatisfy` isRight++        it "decodes FriendList" $ do+            friendList <- eitherDecodeFileStrict' @FriendList+                $ typesDataPath "friend-list.json"+            friendList `shouldSatisfy` isRight++        it "decodes KarmaList" $ do+            karmaList <- eitherDecodeFileStrict' @KarmaList+                $ typesDataPath "karma-list.json"+            karmaList `shouldSatisfy` isRight++        it "decodes TrophyList" $ do+            trophyList <- eitherDecodeFileStrict' @TrophyList+                $ typesDataPath "trophy-list.json"+            trophyList `shouldSatisfy` isRight++        it "decodes Preferences" $ do+            trophyList <- eitherDecodeFileStrict' @Preferences+                $ typesDataPath "prefs.json"+            trophyList `shouldSatisfy` isRight++decodeCommentTypes :: IO ()+decodeCommentTypes = hspec $ do+    describe "Network.Reddit.Types.Comment" $ do+        it "decodes (Listing CommentID Comment)" $ do+            commentListing+                <- eitherDecodeFileStrict' @(Listing CommentID Comment)+                $ typesDataPath "comment-listing.json"+            commentListing `shouldSatisfy` isRight++decodeSubmissionTypes :: IO ()+decodeSubmissionTypes = hspec $ do+    describe "Network.Reddit.Types.Submission" $ do+        it "decodes Submission" $ do+            submission <- eitherDecodeFileStrict' @Submission+                $ typesDataPath "submission.json"+            submission `shouldSatisfy` isRight++    describe "Network.Reddit.Types.Collection" $ do+        it "decodes Collection" $ do+            collection <- eitherDecodeFileStrict' @Collection+                $ typesDataPath "collection.json"+            collection `shouldSatisfy` isRight++decodeSubredditTypes :: IO ()+decodeSubredditTypes = hspec $ do+    describe "Network.Reddit.Types.Subreddit" $ do+        it "decodes Subreddit" $ do+            sr <- eitherDecodeFileStrict' @Subreddit+                $ typesDataPath "subreddit.json"+            sr `shouldSatisfy` isRight++        it "decodes PostRequirements" $ do+            postRequirements <- eitherDecodeFileStrict' @PostRequirements+                $ typesDataPath "post-requirements.json"+            postRequirements `shouldSatisfy` isRight++        it "decodes SubredditRule" $ do+            postRequirements <- eitherDecodeFileStrict' @SubredditRule+                $ typesDataPath "rule.json"+            postRequirements `shouldSatisfy` isRight++        it "decodes Multireddit" $ do+            postRequirements <- eitherDecodeFileStrict' @(Seq Multireddit)+                $ typesDataPath "multireddits.json"+            postRequirements `shouldSatisfy` isRight++decodeMessageTypes :: IO ()+decodeMessageTypes = hspec $ do+    describe "Network.Reddit.Types.Message" $ do+        it "decodes Message" $ do+            msg <- eitherDecodeFileStrict' @(Listing MessageID Message)+                $ typesDataPath "message-listing.json"+            msg `shouldSatisfy` isRight++decodeModerationTypes :: IO ()+decodeModerationTypes = hspec $ do+    describe "Network.Reddit.Types.Moderation" $ do+        it "decodes Ban" $ do+            ban <- eitherDecodeFileStrict' @Ban $ typesDataPath "ban.json"+            ban `shouldSatisfy` isRight++        it "decodes SubredditSettings" $ do+            settings <- eitherDecodeFileStrict' @SubredditSettings+                $ typesDataPath "subreddit-settings.json"+            settings `shouldSatisfy` isRight++        it "decodes Modmail" $ do+            settings <- eitherDecodeFileStrict' @Modmail+                $ typesDataPath "modmail.json"+            settings `shouldSatisfy` isRight++        it "decodes (Listing ModActionID ModAction)" $ do+            modlog <- eitherDecodeFileStrict' @(Listing ModActionID ModAction)+                $ typesDataPath "modaction-listing.json"+            modlog `shouldSatisfy` isRight++        it "decodes ModInviteeList" $ do+            invitees <- eitherDecodeFileStrict' @ModInviteeList+                $ typesDataPath "modinvitee-list.json"+            invitees `shouldSatisfy` isRight++        it "decodes Traffic" $ do+            traffic <- eitherDecodeFileStrict' @Traffic+                $ typesDataPath "traffic.json"+            traffic `shouldSatisfy` isRight++        it "decodes S3ModerationLease" $ do+            lease <- eitherDecodeFileStrict' @S3ModerationLease+                $ typesDataPath "upload-lease.json"+            lease `shouldSatisfy` isRight++decodeFlairTypes :: IO ()+decodeFlairTypes = hspec $ do+    describe "Network.Reddit.Types.Flair" $ do+        it "decodes FlairTemplate" $ do+            flairTemplate <- eitherDecodeFileStrict' @FlairTemplate+                $ typesDataPath "flair-template.json"+            flairTemplate `shouldSatisfy` isRight++    describe "Network.Reddit.Types.Flair" $ do+        it "decodes FlairChoice" $ do+            flairChoices <- eitherDecodeFileStrict' @FlairChoiceList+                $ typesDataPath "flair-response.json"+            flairChoices `shouldSatisfy` isRight++    describe "Network.Reddit.Types.Flair" $ do+        it "decodes UserFlair" $ do+            userFlair <- eitherDecodeFileStrict' @CurrentUserFlair+                $ typesDataPath "flair-response.json"+            userFlair `shouldSatisfy` isRight++decodeWikiTypes :: IO ()+decodeWikiTypes = hspec $ do+    describe "Network.Reddit.Types.Wiki" $ do+        it "decodes WikiPage" $ do+            wikiPage <- eitherDecodeFileStrict' @WikiPage+                $ typesDataPath "wikipage.json"+            wikiPage `shouldSatisfy` isRight++        it "decodes WikiRevision" $ do+            wikiRevListing <- eitherDecodeFileStrict' --+                @(Listing WikiRevisionID WikiRevision)+                $ typesDataPath "wiki-revision-listing.json"+            wikiRevListing `shouldSatisfy` isRight++        it "decodes WikiPageSettings" $ do+            wikipageSettings <- eitherDecodeFileStrict' @WikiPageSettings+                $ typesDataPath "wikipage-settings.json"+            wikipageSettings `shouldSatisfy` isRight++decodeWidgetTypes :: IO ()+decodeWidgetTypes = hspec $ do+    describe "Network.Reddit.Types.Widget" $ do+        it "decodes Widget" $ do+            widgets <- eitherDecodeFileStrict' @WidgetList+                $ typesDataPath "widgets.json"+            widgets `shouldSatisfy` isRight++decodeEmojiTypes :: IO ()+decodeEmojiTypes = hspec $ do+    describe "Network.Reddit.Types.Emoji" $ do+        it "decodes Widget" $ do+            emojis <- eitherDecodeFileStrict' @EmojiList+                $ typesDataPath "emoji-list.json"+            emojis `shouldSatisfy` isRight++decodeLiveTypes :: IO ()+decodeLiveTypes = hspec $ do+    describe "Network.Reddit.Types.Live" $ do+        it "decodes LiveThread" $ do+            liveThread+                <- eitherDecodeFileStrict' @(Listing LiveThreadID LiveThread)+                $ typesDataPath "live-thread.json"+            liveThread `shouldSatisfy` isRight++        it "decodes LiveUpdate" $ do+            liveUpdates+                <- eitherDecodeFileStrict' @(Listing LiveUpdateID LiveUpdate)+                $ typesDataPath "live-update.json"+            liveUpdates `shouldSatisfy` isRight++        it "decodes LiveContributorList" $ do+            liveContributors <- eitherDecodeFileStrict' @LiveContributorList+                $ typesDataPath "live-contributor-list.json"+            liveContributors `shouldSatisfy` isRight++typesDataPath :: FilePath -> FilePath+typesDataPath = (<>) "./tests/data/types/"
+ tests/data/types/ban.json view
@@ -0,0 +1,6 @@+{+  "date": 1580019923.0,+  "rel_id": "rb_xquu2f",+  "name": "<USERNAME>",+  "id": "t2_5fd29d"+}
+ tests/data/types/collection.json view
@@ -0,0 +1,420 @@+{+  "subreddit_id": "t5_3nwlq",+  "description": "This is the description.",+  "primary_link_id": "t3_bn2luj",+  "author_name": "<USERNAME>",+  "collection_id": "847e4548-a3b5-4ad7-afb4-edbfc2ed0a6b",+  "display_layout": null,+  "permalink": "https://www.reddit.com/r/<SUBREDDIT>/collection/847e4548-a3b5-4ad7-afb4-edbfc2ed0a6b",+  "link_ids": ["t3_ncnza3"],+  "title": "A test Collection!",+  "created_at_utc": 1557516469.765,+  "author_id": "t2_14g6bq9",+  "last_update_utc": 1557523530.279,+  "sorted_links": {+    "kind": "Listing",+    "data": {+      "modhash": "",+      "dist": 4,+      "children": [+        {+          "kind": "t3",+          "data": {+            "approved_at_utc": null,+            "subreddit": "<SUBREDDIT>",+            "selftext": "",+            "author_fullname": "t2_apyzf6ma",+            "saved": false,+            "mod_reason_title": null,+            "gilded": 0,+            "clicked": false,+            "title": "<TEST_TITLE>",+            "link_flair_richtext": [],+            "subreddit_name_prefixed": "r/<SUBREDDIT>",+            "hidden": false,+            "pwls": 6,+            "link_flair_css_class": null,+            "downs": 0,+            "thumbnail_height": 140,+            "top_awarded_type": null,+            "hide_score": false,+            "name": "t3_gu20dd",+            "quarantine": false,+            "link_flair_text_color": "dark",+            "upvote_ratio": 0.94,+            "author_flair_background_color": null,+            "subreddit_type": "public",+            "ups": 766,+            "total_awards_received": 5,+            "media_embed": {},+            "thumbnail_width": 140,+            "author_flair_template_id": null,+            "is_original_content": false,+            "user_reports": [],+            "secure_media": null,+            "is_reddit_media_domain": false,+            "is_meta": false,+            "category": null,+            "secure_media_embed": {},+            "link_flair_text": null,+            "can_mod_post": false,+            "score": 766,+            "approved_by": null,+            "author_premium": false,+            "thumbnail": "default",+            "edited": false,+            "author_flair_css_class": null,+            "author_flair_richtext": [],+            "gildings": { "gid_1": 1 },+            "post_hint": "link",+            "content_categories": null,+            "is_self": false,+            "mod_note": null,+            "created": 1621071082.0,+            "link_flair_type": "text",+            "wls": 6,+            "removed_by_category": null,+            "banned_by": null,+            "author_flair_type": "text",+            "domain": "EXAMPLE.com",+            "allow_live_comments": true,+            "selftext_html": null,+            "likes": false,+            "suggested_sort": null,+            "banned_at_utc": null,+            "url_overridden_by_dest": "https://EXAMPLE.com/",+            "view_count": null,+            "archived": false,+            "no_follow": false,+            "is_crosspostable": true,+            "pinned": false,+            "over_18": false,+            "preview": {+              "images": [+                {+                  "source": {+                    "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?auto=webp&amp;s=7540ec77c2abc79540eb70975d55087af0bd4f95",+                    "width": 350,+                    "height": 495+                  },+                  "resolutions": [+                    {+                      "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=108&amp;crop=smart&amp;auto=webp&amp;s=52a86560f439e94697be8a36e4413d4bdecf2c06",+                      "width": 108,+                      "height": 152+                    },+                    {+                      "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=216&amp;crop=smart&amp;auto=webp&amp;s=6bd8b4791be0d70d354c45381162d8e24b5382c0",+                      "width": 216,+                      "height": 305+                    },+                    {+                      "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=320&amp;crop=smart&amp;auto=webp&amp;s=d16e2fb76b99bcb04fb0aab7ff9dc4b933c32def",+                      "width": 320,+                      "height": 452+                    }+                  ],+                  "variants": {},+                  "id": "4UNmijwVBnMCbq9Nwnb80mQCXmdxlGqbohqvoMbFeFQ"+                }+              ],+              "enabled": false+            },+            "all_awardings": [+              {+                "giver_coin_reward": null,+                "subreddit_id": null,+                "is_new": false,+                "days_of_drip_extension": 0,+                "coin_price": 125,+                "id": "award_5f123e3d-4f48-42f4-9c11-e98b566d5897",+                "penny_donate": null,+                "award_sub_type": "GLOBAL",+                "coin_reward": 0,+                "icon_url": "https://i.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png",+                "days_of_premium": 0,+                "tiers_by_required_awardings": null,+                "resized_icons": [+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=16&amp;height=16&amp;auto=webp&amp;s=92932f465d58e4c16b12b6eac4ca07d27e3d11c0",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=32&amp;height=32&amp;auto=webp&amp;s=d11484a208d68a318bf9d4fcf371171a1cb6a7ef",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=48&amp;height=48&amp;auto=webp&amp;s=febdf28b6f39f7da7eb1365325b85e0bb49a9f63",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=64&amp;height=64&amp;auto=webp&amp;s=b4406a2d88bf86fa3dc8a45aacf7e0c7bdccc4fb",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=128&amp;height=128&amp;auto=webp&amp;s=19555b13e3e196b62eeb9160d1ac1d1b372dcb0b",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_width": 2048,+                "static_icon_width": 2048,+                "start_date": null,+                "is_enabled": true,+                "awardings_required_to_grant_benefits": null,+                "description": "When you come across a feel-good thing.",+                "end_date": null,+                "subreddit_coin_reward": 0,+                "count": 1,+                "static_icon_height": 2048,+                "name": "Wholesome",+                "resized_static_icons": [+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=16&amp;height=16&amp;auto=webp&amp;s=92932f465d58e4c16b12b6eac4ca07d27e3d11c0",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=32&amp;height=32&amp;auto=webp&amp;s=d11484a208d68a318bf9d4fcf371171a1cb6a7ef",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=48&amp;height=48&amp;auto=webp&amp;s=febdf28b6f39f7da7eb1365325b85e0bb49a9f63",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=64&amp;height=64&amp;auto=webp&amp;s=b4406a2d88bf86fa3dc8a45aacf7e0c7bdccc4fb",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=128&amp;height=128&amp;auto=webp&amp;s=19555b13e3e196b62eeb9160d1ac1d1b372dcb0b",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_format": null,+                "icon_height": 2048,+                "penny_price": null,+                "award_type": "global",+                "static_icon_url": "https://i.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png"+              },+              {+                "giver_coin_reward": null,+                "subreddit_id": null,+                "is_new": false,+                "days_of_drip_extension": 0,+                "coin_price": 100,+                "id": "gid_1",+                "penny_donate": null,+                "award_sub_type": "GLOBAL",+                "coin_reward": 0,+                "icon_url": "https://www.redditstatic.com/gold/awards/icon/silver_512.png",+                "days_of_premium": 0,+                "tiers_by_required_awardings": null,+                "resized_icons": [+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_16.png",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_32.png",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_48.png",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_64.png",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_128.png",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_width": 512,+                "static_icon_width": 512,+                "start_date": null,+                "is_enabled": true,+                "awardings_required_to_grant_benefits": null,+                "description": "Shows the Silver Award... and that's it.",+                "end_date": null,+                "subreddit_coin_reward": 0,+                "count": 1,+                "static_icon_height": 512,+                "name": "Silver",+                "resized_static_icons": [+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_16.png",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_32.png",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_48.png",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_64.png",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://www.redditstatic.com/gold/awards/icon/silver_128.png",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_format": null,+                "icon_height": 512,+                "penny_price": null,+                "award_type": "global",+                "static_icon_url": "https://www.redditstatic.com/gold/awards/icon/silver_512.png"+              },+              {+                "giver_coin_reward": 0,+                "subreddit_id": null,+                "is_new": false,+                "days_of_drip_extension": 0,+                "coin_price": 80,+                "id": "award_8352bdff-3e03-4189-8a08-82501dd8f835",+                "penny_donate": 0,+                "award_sub_type": "GLOBAL",+                "coin_reward": 0,+                "icon_url": "https://i.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png",+                "days_of_premium": 0,+                "tiers_by_required_awardings": null,+                "resized_icons": [+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=16&amp;height=16&amp;auto=webp&amp;s=73a23bf7f08b633508dedf457f2704c522b94a04",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=32&amp;height=32&amp;auto=webp&amp;s=50f2f16e71d2929e3d7275060af3ad6b851dbfb1",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=48&amp;height=48&amp;auto=webp&amp;s=ca487311563425e195699a4d7e4c57a98cbfde8b",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=64&amp;height=64&amp;auto=webp&amp;s=7b4eedcffb1c09a826e7837532c52979760f1d2b",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=128&amp;height=128&amp;auto=webp&amp;s=e4d5ab237eb71a9f02bb3bf9ad5ee43741918d6c",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_width": 2048,+                "static_icon_width": 2048,+                "start_date": null,+                "is_enabled": true,+                "awardings_required_to_grant_benefits": null,+                "description": "Everything is better with a good hug",+                "end_date": null,+                "subreddit_coin_reward": 0,+                "count": 3,+                "static_icon_height": 2048,+                "name": "Hugz",+                "resized_static_icons": [+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=16&amp;height=16&amp;auto=webp&amp;s=69997ace3ef4ffc099b81d774c2c8f1530602875",+                    "width": 16,+                    "height": 16+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=32&amp;height=32&amp;auto=webp&amp;s=e9519d1999ef9dce5c8a9f59369cb92f52d95319",+                    "width": 32,+                    "height": 32+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=48&amp;height=48&amp;auto=webp&amp;s=f076c6434fb2d2f9075991810fd845c40fa73fc6",+                    "width": 48,+                    "height": 48+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=64&amp;height=64&amp;auto=webp&amp;s=85527145e0c4b754306a30df29e584fd16187636",+                    "width": 64,+                    "height": 64+                  },+                  {+                    "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=128&amp;height=128&amp;auto=webp&amp;s=b8843cdf82c3b741d7af057c14076dcd2621e811",+                    "width": 128,+                    "height": 128+                  }+                ],+                "icon_format": "PNG",+                "icon_height": 2048,+                "penny_price": 0,+                "award_type": "global",+                "static_icon_url": "https://i.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png"+              }+            ],+            "awarders": [],+            "media_only": false,+            "can_gild": true,+            "spoiler": false,+            "locked": false,+            "author_flair_text": null,+            "treatment_tags": [],+            "visited": false,+            "removed_by": null,+            "num_reports": null,+            "distinguished": null,+            "subreddit_id": "t5_2fwo",+            "mod_reason_by": null,+            "removal_reason": null,+            "link_flair_background_color": "",+            "id": "ncnza3",+            "is_robot_indexable": true,+            "report_reasons": null,+            "author": "marcusthethinker",+            "discussion_type": null,+            "num_comments": 35,+            "send_replies": true,+            "whitelist_status": "all_ads",+            "contest_mode": false,+            "mod_reports": [],+            "author_patreon_flair": false,+            "author_flair_text_color": null,+            "permalink": "/r/<SUBREDDI>/comments/ncnza3/<SUBMISSION>/",+            "parent_whitelist_status": "all_ads",+            "stickied": false,+            "url": "https://EXAMPLE.com/",+            "subreddit_subscribers": 3372076,+            "created_utc": 1621042282.0,+            "num_crossposts": 1,+            "media": null,+            "is_video": false+          }+        }+      ],+      "after": null,+      "before": null+    }+  }+}
+ tests/data/types/comment-listing.json view
@@ -0,0 +1,89 @@+{+  "kind": "Listing",+  "data": {+    "modhash": null,+    "dist": 25,+    "children": [+      {+        "kind": "t1",+        "data": {+          "total_awards_received": 0,+          "approved_at_utc": null,+          "comment_type": null,+          "awarders": [],+          "mod_reason_by": null,+          "banned_by": null,+          "author_flair_type": "text",+          "removal_reason": null,+          "link_id": "t3_n72e7m",+          "author_flair_template_id": null,+          "likes": null,+          "replies": "",+          "user_reports": [],+          "saved": false,+          "id": "gxvcp4h",+          "banned_at_utc": null,+          "mod_reason_title": null,+          "gilded": 0,+          "archived": false,+          "no_follow": true,+          "author": "<TEST_REDDITOR>",+          "num_comments": 9,+          "edited": false,+          "can_mod_post": false,+          "created_utc": 1620837086.0,+          "send_replies": true,+          "parent_id": "t3_n72e7m",+          "score": 2,+          "author_fullname": "t2_26009",+          "over_18": false,+          "treatment_tags": [],+          "approved_by": null,+          "mod_note": null,+          "all_awardings": [],+          "subreddit_id": "t5_39ezv",+          "body": "<TEST_BODY>",+          "link_title": "<TEST>",+          "author_flair_css_class": null,+          "name": "t1_gxvcp4h",+          "author_patreon_flair": false,+          "downs": 0,+          "author_flair_richtext": [],+          "is_submitter": false,+          "body_html": "<TEST_BODY>",+          "gildings": {},+          "collapsed_reason": null,+          "distinguished": null,+          "associated_award": null,+          "stickied": false,+          "author_premium": true,+          "can_gild": true,+          "top_awarded_type": null,+          "author_flair_text_color": null,+          "score_hidden": false,+          "permalink": "/r/<TEST_REDDIT>/comments/n72e7m/<TEST_POST>/gxvcp4h/",+          "num_reports": null,+          "link_permalink": "https://www.reddit.com/r/<TEST_REDDIT>/comments/n72e7m/<TEST_POST>/",+          "report_reasons": null,+          "link_author": "<TEST_AUTHOR>",+          "subreddit": "<TEST_REDDIT>",+          "author_flair_text": null,+          "link_url": "https://www.reddit.com/r/<TEST_REDDIT>/comments/n72e7m/<TEST_POST>/",+          "created": 1620865886.0,+          "collapsed": false,+          "subreddit_name_prefixed": "r/<TEST_REDDIT>",+          "controversiality": 0,+          "locked": false,+          "author_flair_background_color": null,+          "collapsed_because_crowd_control": null,+          "mod_reports": [],+          "quarantine": false,+          "subreddit_type": "public",+          "ups": 2+        }+      }+    ],+    "after": "t1_gu9g101",+    "before": null+  }+}
+ tests/data/types/emoji-list.json view
@@ -0,0 +1,307 @@+{+  "snoomojis": {+    "cake": {+      "url": "https://emoji.redditmedia.com/46kel8lf1guz_t5_3nqvj/cake",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "cat_blep": {+      "url": "https://emoji.redditmedia.com/p9sxc1zh1guz_t5_3nqvj/cat_blep",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "doge": {+      "url": "https://emoji.redditmedia.com/f0fypg8k1guz_t5_3nqvj/doge",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "downvote": {+      "url": "https://emoji.redditmedia.com/r05m1xcm1guz_t5_3nqvj/downvote",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "hamster": {+      "url": "https://emoji.redditmedia.com/63xo3dun1guz_t5_3nqvj/hamster",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "illuminati": {+      "url": "https://emoji.redditmedia.com/mv60bklq1guz_t5_3nqvj/illuminati",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "kappa": {+      "url": "https://emoji.redditmedia.com/2uaduvnr1guz_t5_3nqvj/kappa",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "karma": {+      "url": "https://emoji.redditmedia.com/dgnf69ls1guz_t5_3nqvj/karma",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "orly": {+      "url": "https://emoji.redditmedia.com/crum4urt1guz_t5_3nqvj/orly",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "partyparrot": {+      "url": "https://emoji.redditmedia.com/rk1bpelv1guz_t5_3nqvj/partyparrot",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "pupper": {+      "url": "https://emoji.redditmedia.com/l73ksapw1guz_t5_3nqvj/pupper",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "redditgold": {+      "url": "https://emoji.redditmedia.com/5knu5pox1guz_t5_3nqvj/redditgold",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "sloth": {+      "url": "https://emoji.redditmedia.com/rpczqdwy1guz_t5_3nqvj/sloth",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo": {+      "url": "https://emoji.redditmedia.com/3whaar0s9ezz_t5_3nqvj/snoo",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_angry": {+      "url": "https://emoji.redditmedia.com/8qgfoo9waezz_t5_3nqvj/snoo_angry",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_biblethump": {+      "url": "https://emoji.redditmedia.com/akdtlr0vaezz_t5_3nqvj/snoo_biblethump",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_dealwithit": {+      "url": "https://emoji.redditmedia.com/94ntcn2taezz_t5_3nqvj/snoo_dealwithit",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_disapproval": {+      "url": "https://emoji.redditmedia.com/49dz5ljraezz_t5_3nqvj/snoo_disapproval",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_facepalm": {+      "url": "https://emoji.redditmedia.com/wzxf63qpaezz_t5_3nqvj/snoo_facepalm",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_feelsbadman": {+      "url": "https://emoji.redditmedia.com/7xdss4doaezz_t5_3nqvj/snoo_feelsbadman",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_feelsgoodman": {+      "url": "https://emoji.redditmedia.com/nbv1idzmaezz_t5_3nqvj/snoo_feelsgoodman",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_hearteyes": {+      "url": "https://emoji.redditmedia.com/igu167dlaezz_t5_3nqvj/snoo_hearteyes",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_hug": {+      "url": "https://emoji.redditmedia.com/wqivmcpjaezz_t5_3nqvj/snoo_hug",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_joy": {+      "url": "https://emoji.redditmedia.com/ehw8l3piaezz_t5_3nqvj/snoo_joy",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_putback": {+      "url": "https://emoji.redditmedia.com/8228r6bhaezz_t5_3nqvj/snoo_putback",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_sad": {+      "url": "https://emoji.redditmedia.com/a761ck7gaezz_t5_3nqvj/snoo_sad",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_scream": {+      "url": "https://emoji.redditmedia.com/19g4yg2faezz_t5_3nqvj/snoo_scream",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_shrug": {+      "url": "https://emoji.redditmedia.com/mvwd04vdaezz_t5_3nqvj/snoo_shrug",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_simple_smile": {+      "url": "https://emoji.redditmedia.com/dhbi1omcaezz_t5_3nqvj/snoo_simple_smile",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_smile": {+      "url": "https://emoji.redditmedia.com/fh0615maaezz_t5_3nqvj/snoo_smile",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_surprised": {+      "url": "https://emoji.redditmedia.com/hvfzdhf9aezz_t5_3nqvj/snoo_surprised",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_tableflip": {+      "url": "https://emoji.redditmedia.com/nbgogsm7aezz_t5_3nqvj/snoo_tableflip",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_thoughtful": {+      "url": "https://emoji.redditmedia.com/7jhvwsc5aezz_t5_3nqvj/snoo_thoughtful",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_tongue": {+      "url": "https://emoji.redditmedia.com/pgm55sg3aezz_t5_3nqvj/snoo_tongue",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_trollface": {+      "url": "https://emoji.redditmedia.com/mssz6vvv9ezz_t5_3nqvj/snoo_trollface",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "snoo_wink": {+      "url": "https://emoji.redditmedia.com/p0vdh98u9ezz_t5_3nqvj/snoo_wink",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "table": {+      "url": "https://emoji.redditmedia.com/cbl32coz9ezz_t5_3nqvj/table",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "table_flip": {+      "url": "https://emoji.redditmedia.com/l7sfl3z0aezz_t5_3nqvj/table_flip",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    },+    "upvote": {+      "url": "https://emoji.redditmedia.com/ad1td4bx9ezz_t5_3nqvj/upvote",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_6zfp6ii"+    }+  },+  "t5_9o2xw": {+    "emoji1": {+      "url": "https://emoji.redditmedia.com/mjemkgdm30871_t5_9o2xw/emoji1",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_20ddlx"+    },+    "emoji2": {+      "url": "https://emoji.redditmedia.com/001he1dfv6871_t5_9o2xw/emoji2",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_20ddlx"+    },+    "emoji3": {+      "url": "https://emoji.redditmedia.com/jy4wlo7fw6871_t5_9o2xw/emoji3",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_20ddlx"+    },+    "emoji4": {+      "url": "https://emoji.redditmedia.com/weg8e0clw6871_t5_9o2xw/emoji4",+      "user_flair_allowed": true,+      "post_flair_allowed": true,+      "mod_flair_only": false,+      "created_by": "t2_20ddlx"+    }+  }+}
+ tests/data/types/flair-response.json view
@@ -0,0 +1,24 @@+{+  "current": {+    "flair_css_class": null,+    "flair_template_id": null,+    "flair_text": null,+    "flair_position": "left"+  },+  "choices": [+    {+      "flair_css_class": "",+      "flair_template_id": "e01583c8-d014-4ccc-a098-321cca920a24",+      "flair_text_editable": false,+      "flair_position": "left",+      "flair_text": "SATISFIED"+    },+    {+      "flair_css_class": "",+      "flair_template_id": "bbedb00a-96d2-a845-bb02-fb6659be0afa",+      "flair_text_editable": false,+      "flair_position": "left",+      "flair_text": "STATS"+    }+  ]+}
+ tests/data/types/flair-template.json view
@@ -0,0 +1,14 @@+{+  "allowable_content": "all",+  "text": "<TEST_FLAIR>",+  "text_color": "dark",+  "mod_only": false,+  "background_color": "transparent",+  "id": "1054d14a-a271-4cb8-ad21-49e2608e6287",+  "css_class": "",+  "max_emojis": 10,+  "richtext": [],+  "text_editable": false,+  "override_css": false,+  "type": "text"+}
+ tests/data/types/friend-list.json view
@@ -0,0 +1,13 @@+{+  "kind": "UserList",+  "data": {+    "children": [+      {+        "date": 1620649640.0,+        "rel_id": "r9_2jqowo2",+        "name": "some-friend",+        "id": "t2_dk3j20m"+      }+    ]+  }+}
+ tests/data/types/karma-list.json view
@@ -0,0 +1,9 @@+{+  "kind": "KarmaList",+  "data": [+    { "sr": "<TEST_SUBREDDIT>", "comment_karma": 8, "link_karma": 12 },+    { "sr": "subreddit_stats", "comment_karma": 2, "link_karma": 1 },+    { "sr": "redditdev", "comment_karma": 1, "link_karma": 1 },+    { "sr": "AskReddit", "comment_karma": -1, "link_karma": 1 }+  ]+}
+ tests/data/types/live-contributor-list.json view
@@ -0,0 +1,22 @@+[+  {+    "kind": "UserList",+    "data": {+      "children": [+        {+          "rel_id": null,+          "permissions": ["edit", "update"],+          "id": "t2_qjm2v01b",+          "name": "user1"+        },+        {+          "rel_id": null,+          "permissions": ["all"],+          "id": "t2_lh39o9a1",+          "name": "user2"+        }+      ]+    }+  },+  { "kind": "UserList", "data": { "children": [] } }+]
+ tests/data/types/live-thread.json view
@@ -0,0 +1,37 @@+{+  "kind": "Listing",+  "data": {+    "after": "LiveUpdateEvent_179mzxw6cq1coe",+    "dist": 1,+    "modhash": null,+    "geo_filter": "",+    "children": [+      {+        "kind": "LiveUpdateEvent",+        "data": {+          "total_views": null,+          "description": "My live thread",+          "description_html": "",+          "title": "My live thread",+          "created": 1625693395.0,+          "created_utc": 1625664595.0,+          "button_cta": "",+          "websocket_url": "wss://ws-xxxxxxxxxxxxxxxxx.wss.redditmedia.com/live/xxxxxxxxxxxxx?m=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",+          "is_announcement": false,+          "state": "live",+          "announcement_url": "",+          "nsfw": false,+          "resources": "",+          "num_times_dismissable": 1,+          "icon": "",+          "viewer_count_fuzzed": true,+          "resources_html": "",+          "id": "179mzxw6cq1coe",+          "viewer_count": 4,+          "name": "LiveUpdateEvent_179mzxw6cq1coe"+        }+      }+    ],+    "before": null+  }+}
+ tests/data/types/live-update.json view
@@ -0,0 +1,52 @@+{+  "kind": "Listing",+  "data": {+    "after": "LiveUpdate_c3565b74-aaaa-4c31-8fcb-31a775e91504",+    "dist": null,+    "modhash": null,+    "geo_filter": "",+    "children": [+      {+        "kind": "LiveUpdate",+        "data": {+          "body": "https://twitter.com/xxxxx/status/xxxxxxxxxxxxxxxxxxx?s=21",+          "name": "LiveUpdate_ c3565b74-aaaa-4c31-8fcb-31a775e91504",+          "mobile_embeds": [+            {+              "provider_url": "https://twitter.com",+              "description": "",+              "original_url": "https://twitter.com/xxxxx/status/xxxxxxxxxxxxxxxxxxx?s=21",+              "url": "https://twitter.com/XXXXX/status/xxxxxxxxxxxxxxxxxxx",+              "title": "Title",+              "html": "",+              "thumbnail_width": 46,+              "width": 550,+              "thumbnail_url": "https://abs.twimg.com/errors/logo46x38.png",+              "author_name": "Author",+              "version": "1.0",+              "provider_name": "Twitter",+              "cache_age": 3153600000,+              "type": "rich",+              "thumbnail_height": 38,+              "author_url": "https://twitter.com/XXXXX"+            }+          ],+          "author": "author",+          "embeds": [+            {+              "url": "https://twitter.com/xxxxx/status/xxxxxxxxxxxxxxxxxxx?s=21",+              "width": 485,+              "height": null+            }+          ],+          "created": 1625294009.0,+          "created_utc": 1625265209.0,+          "body_html": "",+          "stricken": false,+          "id": " c3565b74-aaaa-4c31-8fcb-31a775e91504"+        }+      }+    ],+    "before": null+  }+}
+ tests/data/types/message-listing.json view
@@ -0,0 +1,41 @@+{+  "kind": "Listing",+  "data": {+    "modhash": null,+    "dist": 1,+    "children": [+      {+        "kind": "t4",+        "data": {+          "first_message": null,+          "first_message_name": null,+          "subreddit": null,+          "likes": null,+          "replies": "",+          "author_fullname": "t2_jha732wi",+          "id": "11tdsdh",+          "subject": "<TEST_SUBJECT>",+          "associated_awarding_id": null,+          "score": 0,+          "author": "<TEST_AUTHOR>",+          "num_comments": null,+          "parent_id": null,+          "subreddit_name_prefixed": null,+          "new": true,+          "type": "unknown",+          "body": "<TEST_BODY>",+          "dest": "<TEST_DEST>",+          "was_comment": false,+          "body_html": "",+          "name": "t4_3twa2ic",+          "created": 1621719438.0,+          "created_utc": 1621690638.0,+          "context": "",+          "distinguished": null+        }+      }+    ],+    "after": null,+    "before": null+  }+}
+ tests/data/types/modaction-listing.json view
@@ -0,0 +1,31 @@+{+  "kind": "Listing",+  "data": {+    "modhash": null,+    "dist": null,+    "children": [+      {+        "kind": "modaction",+        "data": {+          "description": null,+          "target_body": null,+          "mod_id36": "73whj1o",+          "created_utc": 1623749800.0,+          "subreddit": "<SUBREDDIT>",+          "target_title": null,+          "target_permalink": null,+          "subreddit_name_prefixed": "r/<SUBREDDIT>",+          "details": "flair_template",+          "action": "editflair",+          "target_author": "",+          "target_fullname": null,+          "sr_id36": "yku5lb",+          "id": "ModAction_3058174c-cdbd-11eb-abdf-fe311ec10b50",+          "mod": "<USERNAME>"+        }+      }+    ],+    "after": "ModAction_3058174c-cdbd-11eb-abdf-fe311ec10b50",+    "before": null+  }+}
+ tests/data/types/modinvitee-list.json view
@@ -0,0 +1,29 @@+{+  "after": null,+  "moderators": {+    "t2_o6m4h": {+      "username": "<USERNAME>",+      "accountIcon": "https://www.redditstatic.com/avatars/avatar_default_10_94E044.png",+      "authorFlairText": null,+      "moddedAtUTC": 1578247466,+      "modPermissions": {+        "wiki": true,+        "all": true,+        "chat_operator": true,+        "chat_config": true,+        "posts": true,+        "access": true,+        "mail": true,+        "config": true,+        "flair": true+      },+      "iconSize": [256, 256],+      "postKarma": 7503,+      "id": "t2_o6m4h"+    }+  },+  "moderatorIds": ["t2_6wm4p"],+  "allUsersLoaded": true,+  "subredditId": "t5_zy0ds",+  "before": null+}
+ tests/data/types/modmail.json view
@@ -0,0 +1,71 @@+{+  "conversations": {+    "f2bb20": {+      "isAuto": false,+      "participant": {+        "isMod": false,+        "isAdmin": false,+        "name": "<USER>",+        "isOp": true,+        "isParticipant": true,+        "isApproved": false,+        "isHidden": false,+        "id": 737031422529,+        "isDeleted": false+      },+      "objIds": [{ "id": "32n1w8", "key": "messages" }],+      "isRepliable": true,+      "lastUserUpdate": "2021-06-10T12:03:47.698298+00:00",+      "isInternal": false,+      "lastModUpdate": null,+      "authors": [+        {+          "isMod": false,+          "isAdmin": false,+          "name": "<USER>",+          "isOp": true,+          "isParticipant": true,+          "isApproved": false,+          "isHidden": false,+          "id": 737031422529,+          "isDeleted": false+        }+      ],+      "lastUpdated": "2021-06-10T12:03:47.698298+00:00",+      "legacyFirstMessageId": "12bmnst",+      "state": 0,+      "lastUnread": "2021-06-10T12:03:47.725663+00:00",+      "owner": {+        "displayName": "<SUBREDDIT>",+        "type": "subreddit",+        "id": "t5_2bhw4f"+      },+      "subject": "<SUBJECT>",+      "id": "2eowf",+      "isHighlighted": false,+      "numMessages": 1+    }+  },+  "messages": {+    "32n1w8": {+      "body": "",+      "author": {+        "isMod": false,+        "isAdmin": false,+        "name": "<USER>",+        "isOp": true,+        "isParticipant": true,+        "isApproved": false,+        "isHidden": false,+        "id": 737031422529,+        "isDeleted": false+      },+      "isInternal": false,+      "date": "2021-06-10T12:03:47.698298+00:00",+      "bodyMarkdown": "",+      "id": "32n1w8"+    }+  },+  "viewerId": "t2_2f20xo",+  "conversationIds": ["f2bb20"]+}
+ tests/data/types/multireddits.json view
@@ -0,0 +1,62 @@+[+  {+    "kind": "LabeledMulti",+    "data": {+      "can_edit": true,+      "display_name": "foo_fxk203df",+      "name": "foo_fxk203df",+      "description_html": "",+      "created": 1432648343.0,+      "copied_from": "/user/<USERNAME>/m/foo_6u1iortsb5",+      "icon_url": null,+      "subreddits": [],+      "created_utc": 1432619543.0,+      "key_color": "#cee3f8",+      "visibility": "private",+      "icon_name": "",+      "weighting_scheme": "classic",+      "path": "/user/<USERNAME>/m/foo_fxk203df",+      "description_md": ""+    }+  },+  {+    "kind": "LabeledMulti",+    "data": {+      "can_edit": true,+      "display_name": "foo_23odsxk2",+      "name": "foo_23odsxk2",+      "description_html": "",+      "created": 1432649032.0,+      "copied_from": null,+      "icon_url": null,+      "subreddits": [],+      "created_utc": 1432620232.0,+      "key_color": "#cee3f8",+      "visibility": "private",+      "icon_name": "",+      "weighting_scheme": "classic",+      "path": "/user/<USERNAME>/m/foo_23odsxk2",+      "description_md": ""+    }+  },+  {+    "kind": "LabeledMulti",+    "data": {+      "can_edit": true,+      "display_name": "publicempty",+      "name": "publicempty",+      "description_html": "",+      "created": 1416450706.0,+      "copied_from": null,+      "icon_url": null,+      "subreddits": [],+      "created_utc": 1416421906.0,+      "key_color": "#cee3f8",+      "visibility": "public",+      "icon_name": "",+      "weighting_scheme": "classic",+      "path": "/user/<USERNAME>/m/publicempty",+      "description_md": ""+    }+  }+]
+ tests/data/types/poll-submission.json view
@@ -0,0 +1,124 @@+{+  "kind": "t3",+  "data": {+    "author_flair_background_color": "",+    "approved_at_utc": null,+    "subreddit": "<SUBREDDIT>",+    "selftext": "My delightful poll",+    "user_reports": [],+    "saved": false,+    "mod_reason_title": null,+    "gilded": 0,+    "clicked": false,+    "title": "Test Poll",+    "link_flair_richtext": [{ "e": "text", "t": "Test flair text" }],+    "subreddit_name_prefixed": "r/<SUBREDDIT>",+    "hidden": false,+    "pwls": null,+    "link_flair_css_class": "",+    "downs": 0,+    "thumbnail_height": null,+    "parent_whitelist_status": null,+    "hide_score": false,+    "name": "t3_x20fvo",+    "quarantine": false,+    "link_flair_text_color": "dark",+    "upvote_ratio": 1.0,+    "ignore_reports": false,+    "subreddit_type": "restricted",+    "ups": 1,+    "domain": "self.<SUBREDDIT>",+    "media_embed": {},+    "thumbnail_width": null,+    "author_flair_template_id": null,+    "is_original_content": false,+    "author_fullname": "t2_14g6bq9",+    "secure_media": null,+    "is_reddit_media_domain": false,+    "is_meta": false,+    "category": null,+    "secure_media_embed": {},+    "link_flair_text": "Test flair text",+    "can_mod_post": true,+    "score": 1,+    "approved_by": null,+    "author_premium": false,+    "thumbnail": "self",+    "edited": false,+    "author_flair_css_class": "",+    "author_flair_richtext": [{ "e": "text", "t": "" }],+    "gildings": {},+    "content_categories": null,+    "is_self": true,+    "mod_note": null,+    "created": 1588171169.0,+    "link_flair_type": "richtext",+    "wls": null,+    "removed_by_category": null,+    "banned_by": null,+    "author_flair_type": "richtext",+    "total_awards_received": 0,+    "allow_live_comments": false,+    "selftext_html": "",+    "likes": true,+    "suggested_sort": null,+    "banned_at_utc": null,+    "view_count": null,+    "archived": false,+    "no_follow": false,+    "spam": false,+    "is_crosspostable": true,+    "pinned": false,+    "over_18": false,+    "all_awardings": [],+    "awarders": [],+    "media_only": false,+    "link_flair_template_id": "9ac711a4-1ddf-11e9-aaaa-0e22784c70ce",+    "can_gild": false,+    "removed": false,+    "spoiler": false,+    "locked": false,+    "author_flair_text": "",+    "treatment_tags": [],+    "rte_mode": "markdown",+    "visited": false,+    "removed_by": null,+    "num_reports": 0,+    "distinguished": null,+    "subreddit_id": "t5_0zl3s",+    "mod_reason_by": null,+    "removal_reason": null,+    "link_flair_background_color": "#ffd635",+    "id": "x20fvo",+    "is_robot_indexable": true,+    "num_duplicates": 0,+    "report_reasons": [],+    "author": "<USERNAME>",+    "discussion_type": null,+    "num_comments": 0,+    "send_replies": true,+    "media": null,+    "contest_mode": false,+    "poll_data": {+      "user_selection": null,+      "options": [+        { "text": "Yes", "vote_count": 0, "id": "577567" },+        { "text": "No", "vote_count": 0, "id": "577568" }+      ],+      "voting_end_timestamp": 1588660769955,+      "total_vote_count": 0+    },+    "author_patreon_flair": false,+    "approved": false,+    "author_flair_text_color": "dark",+    "permalink": "/r/<SUBREDDIT>/comments/x20fvo/test_poll/",+    "whitelist_status": null,+    "stickied": false,+    "url": "https://www.reddit.com/r/<SUBREDDIT>/comments/x20fvo/test_poll/",+    "subreddit_subscribers": 1,+    "created_utc": 1588142369.0,+    "num_crossposts": 0,+    "mod_reports": [],+    "is_video": false+  }+}
+ tests/data/types/post-requirements.json view
@@ -0,0 +1,29 @@+{+  "domain_blacklist": ["megafakememes.com", "blobbo.com"],+  "body_restriction_policy": "none",+  "domain_whitelist": [],+  "title_regexes": [],+  "body_blacklisted_strings": [+    "sdkfsdlkfjl",+    "sdlkj3j2lkjskfkj4",+    "sdkfj3k2ksdkvkjva2kiwi"+  ],+  "body_required_strings": [],+  "title_text_min_length": null,+  "is_flair_required": false,+  "title_text_max_length": null,+  "body_regexes": [],+  "link_repost_age": null,+  "body_text_min_length": null,+  "link_restriction_policy": "blacklist",+  "body_text_max_length": null,+  "title_required_strings": [],+  "title_blacklisted_strings": [+    "sdflksdfksjdfl",+    "werwetwetwe",+    "123jdsfkj392",+    "3923jkflsdkjvncal"+  ],+  "guidelines_text": "Be nice",+  "guidelines_display_policy": "all"+}
+ tests/data/types/prefs.json view
@@ -0,0 +1,80 @@+{+  "beta": false,+  "default_theme_sr": null,+  "threaded_messages": true,+  "email_comment_reply": true,+  "private_feeds": true,+  "activity_relevant_ads": true,+  "email_messages": false,+  "profile_opt_out": false,+  "video_autoplay": true,+  "third_party_site_data_personalized_content": false,+  "show_link_flair": true,+  "show_trending": false,+  "design_beta": true,+  "monitor_mentions": true,+  "hide_downs": false,+  "research": false,+  "ignore_suggested_sort": false,+  "show_presence": false,+  "email_upvote_comment": false,+  "email_digests": false,+  "layout": 0,+  "num_comments": 200,+  "feed_recommendations_enabled": true,+  "label_nsfw": true,+  "clickgadget": true,+  "use_global_defaults": false,+  "show_snoovatar": false,+  "over_18": true,+  "show_stylesheets": true,+  "live_orangereds": true,+  "enable_default_themes": false,+  "legacy_search": false,+  "domain_details": true,+  "collapse_left_bar": false,+  "lang": "en",+  "hide_ups": false,+  "third_party_data_personalized_ads": false,+  "email_chat_request": true,+  "allow_clicktracking": false,+  "hide_from_robots": false,+  "show_twitter": false,+  "compress": false,+  "store_visits": false,+  "threaded_modmail": false,+  "email_upvote_post": true,+  "min_link_score": -4,+  "media_preview": "subreddit",+  "email_user_new_follower": true,+  "nightmode": false,+  "highlight_controversial": false,+  "geopopular": "",+  "third_party_site_data_personalized_ads": false,+  "survey_last_seen_time": 1624710973304,+  "min_comment_score": -4,+  "public_votes": false,+  "show_location_based_recommendations": true,+  "email_post_reply": true,+  "collapse_read_messages": false,+  "show_flair": true,+  "mark_messages_read": true,+  "search_include_over_18": true,+  "no_profanity": true,+  "hide_ads": false,+  "third_party_personalized_ads": false,+  "email_username_mention": true,+  "top_karma_subreddits": true,+  "newwindow": false,+  "numsites": 25,+  "media": "subreddit",+  "email_private_message": true,+  "send_crosspost_messages": true,+  "send_welcome_messages": false,+  "public_server_seconds": false,+  "show_gold_expiration": false,+  "highlight_new_comments": true,+  "email_unsubscribe_all": false,+  "default_comment_sort": "confidence",+  "accept_pms": "everyone"+}
+ tests/data/types/rule.json view
@@ -0,0 +1,9 @@+{+  "kind": "link",+  "description": "A rule",+  "short_name": "Some short name",+  "violation_reason": "none",+  "created_utc": 1587969502.0,+  "priority": 0,+  "description_html": ""+}
+ tests/data/types/submission.json view
@@ -0,0 +1,395 @@+{+  "kind": "t3",+  "data": {+    "approved_at_utc": null,+    "subreddit": "<SUBREDDIT>",+    "selftext": "",+    "author_fullname": "t2_apyzf6ma",+    "saved": false,+    "mod_reason_title": null,+    "gilded": 0,+    "clicked": false,+    "title": "<TEST_TITLE>",+    "link_flair_richtext": [],+    "subreddit_name_prefixed": "r/<SUBREDDIT>",+    "hidden": false,+    "pwls": 6,+    "link_flair_css_class": null,+    "downs": 0,+    "thumbnail_height": 140,+    "top_awarded_type": null,+    "hide_score": false,+    "name": "t3_gu20dd",+    "quarantine": false,+    "link_flair_text_color": "dark",+    "upvote_ratio": 0.94,+    "author_flair_background_color": null,+    "subreddit_type": "public",+    "ups": 766,+    "total_awards_received": 5,+    "media_embed": {},+    "thumbnail_width": 140,+    "author_flair_template_id": null,+    "is_original_content": false,+    "user_reports": [],+    "secure_media": null,+    "is_reddit_media_domain": false,+    "is_meta": false,+    "category": null,+    "secure_media_embed": {},+    "link_flair_text": null,+    "can_mod_post": false,+    "score": 766,+    "approved_by": null,+    "author_premium": false,+    "thumbnail": "default",+    "edited": false,+    "author_flair_css_class": null,+    "author_flair_richtext": [],+    "gildings": { "gid_1": 1 },+    "post_hint": "link",+    "content_categories": null,+    "is_self": false,+    "mod_note": null,+    "created": 1621071082.0,+    "link_flair_type": "text",+    "wls": 6,+    "removed_by_category": null,+    "banned_by": null,+    "author_flair_type": "text",+    "domain": "EXAMPLE.com",+    "allow_live_comments": true,+    "selftext_html": null,+    "likes": false,+    "suggested_sort": null,+    "banned_at_utc": null,+    "url_overridden_by_dest": "https://EXAMPLE.com/",+    "view_count": null,+    "archived": false,+    "no_follow": false,+    "is_crosspostable": true,+    "pinned": false,+    "over_18": false,+    "preview": {+      "images": [+        {+          "source": {+            "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?auto=webp&amp;s=7540ec77c2abc79540eb70975d55087af0bd4f95",+            "width": 350,+            "height": 495+          },+          "resolutions": [+            {+              "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=108&amp;crop=smart&amp;auto=webp&amp;s=52a86560f439e94697be8a36e4413d4bdecf2c06",+              "width": 108,+              "height": 152+            },+            {+              "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=216&amp;crop=smart&amp;auto=webp&amp;s=6bd8b4791be0d70d354c45381162d8e24b5382c0",+              "width": 216,+              "height": 305+            },+            {+              "url": "https://external-preview.redd.it/Y9JVej1vP5IN2Ty6fBDnX4wRFyZ2J_OHELULoZcnQ-s.jpg?width=320&amp;crop=smart&amp;auto=webp&amp;s=d16e2fb76b99bcb04fb0aab7ff9dc4b933c32def",+              "width": 320,+              "height": 452+            }+          ],+          "variants": {},+          "id": "4UNmijwVBnMCbq9Nwnb80mQCXmdxlGqbohqvoMbFeFQ"+        }+      ],+      "enabled": false+    },+    "all_awardings": [+      {+        "giver_coin_reward": null,+        "subreddit_id": null,+        "is_new": false,+        "days_of_drip_extension": 0,+        "coin_price": 125,+        "id": "award_5f123e3d-4f48-42f4-9c11-e98b566d5897",+        "penny_donate": null,+        "award_sub_type": "GLOBAL",+        "coin_reward": 0,+        "icon_url": "https://i.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png",+        "days_of_premium": 0,+        "tiers_by_required_awardings": null,+        "resized_icons": [+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=16&amp;height=16&amp;auto=webp&amp;s=92932f465d58e4c16b12b6eac4ca07d27e3d11c0",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=32&amp;height=32&amp;auto=webp&amp;s=d11484a208d68a318bf9d4fcf371171a1cb6a7ef",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=48&amp;height=48&amp;auto=webp&amp;s=febdf28b6f39f7da7eb1365325b85e0bb49a9f63",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=64&amp;height=64&amp;auto=webp&amp;s=b4406a2d88bf86fa3dc8a45aacf7e0c7bdccc4fb",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=128&amp;height=128&amp;auto=webp&amp;s=19555b13e3e196b62eeb9160d1ac1d1b372dcb0b",+            "width": 128,+            "height": 128+          }+        ],+        "icon_width": 2048,+        "static_icon_width": 2048,+        "start_date": null,+        "is_enabled": true,+        "awardings_required_to_grant_benefits": null,+        "description": "When you come across a feel-good thing.",+        "end_date": null,+        "subreddit_coin_reward": 0,+        "count": 1,+        "static_icon_height": 2048,+        "name": "Wholesome",+        "resized_static_icons": [+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=16&amp;height=16&amp;auto=webp&amp;s=92932f465d58e4c16b12b6eac4ca07d27e3d11c0",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=32&amp;height=32&amp;auto=webp&amp;s=d11484a208d68a318bf9d4fcf371171a1cb6a7ef",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=48&amp;height=48&amp;auto=webp&amp;s=febdf28b6f39f7da7eb1365325b85e0bb49a9f63",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=64&amp;height=64&amp;auto=webp&amp;s=b4406a2d88bf86fa3dc8a45aacf7e0c7bdccc4fb",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://preview.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png?width=128&amp;height=128&amp;auto=webp&amp;s=19555b13e3e196b62eeb9160d1ac1d1b372dcb0b",+            "width": 128,+            "height": 128+          }+        ],+        "icon_format": null,+        "icon_height": 2048,+        "penny_price": null,+        "award_type": "global",+        "static_icon_url": "https://i.redd.it/award_images/t5_22cerq/5izbv4fn0md41_Wholesome.png"+      },+      {+        "giver_coin_reward": null,+        "subreddit_id": null,+        "is_new": false,+        "days_of_drip_extension": 0,+        "coin_price": 100,+        "id": "gid_1",+        "penny_donate": null,+        "award_sub_type": "GLOBAL",+        "coin_reward": 0,+        "icon_url": "https://www.redditstatic.com/gold/awards/icon/silver_512.png",+        "days_of_premium": 0,+        "tiers_by_required_awardings": null,+        "resized_icons": [+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_16.png",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_32.png",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_48.png",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_64.png",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_128.png",+            "width": 128,+            "height": 128+          }+        ],+        "icon_width": 512,+        "static_icon_width": 512,+        "start_date": null,+        "is_enabled": true,+        "awardings_required_to_grant_benefits": null,+        "description": "Shows the Silver Award... and that's it.",+        "end_date": null,+        "subreddit_coin_reward": 0,+        "count": 1,+        "static_icon_height": 512,+        "name": "Silver",+        "resized_static_icons": [+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_16.png",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_32.png",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_48.png",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_64.png",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://www.redditstatic.com/gold/awards/icon/silver_128.png",+            "width": 128,+            "height": 128+          }+        ],+        "icon_format": null,+        "icon_height": 512,+        "penny_price": null,+        "award_type": "global",+        "static_icon_url": "https://www.redditstatic.com/gold/awards/icon/silver_512.png"+      },+      {+        "giver_coin_reward": 0,+        "subreddit_id": null,+        "is_new": false,+        "days_of_drip_extension": 0,+        "coin_price": 80,+        "id": "award_8352bdff-3e03-4189-8a08-82501dd8f835",+        "penny_donate": 0,+        "award_sub_type": "GLOBAL",+        "coin_reward": 0,+        "icon_url": "https://i.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png",+        "days_of_premium": 0,+        "tiers_by_required_awardings": null,+        "resized_icons": [+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=16&amp;height=16&amp;auto=webp&amp;s=73a23bf7f08b633508dedf457f2704c522b94a04",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=32&amp;height=32&amp;auto=webp&amp;s=50f2f16e71d2929e3d7275060af3ad6b851dbfb1",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=48&amp;height=48&amp;auto=webp&amp;s=ca487311563425e195699a4d7e4c57a98cbfde8b",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=64&amp;height=64&amp;auto=webp&amp;s=7b4eedcffb1c09a826e7837532c52979760f1d2b",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/ks45ij6w05f61_oldHugz.png?width=128&amp;height=128&amp;auto=webp&amp;s=e4d5ab237eb71a9f02bb3bf9ad5ee43741918d6c",+            "width": 128,+            "height": 128+          }+        ],+        "icon_width": 2048,+        "static_icon_width": 2048,+        "start_date": null,+        "is_enabled": true,+        "awardings_required_to_grant_benefits": null,+        "description": "Everything is better with a good hug",+        "end_date": null,+        "subreddit_coin_reward": 0,+        "count": 3,+        "static_icon_height": 2048,+        "name": "Hugz",+        "resized_static_icons": [+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=16&amp;height=16&amp;auto=webp&amp;s=69997ace3ef4ffc099b81d774c2c8f1530602875",+            "width": 16,+            "height": 16+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=32&amp;height=32&amp;auto=webp&amp;s=e9519d1999ef9dce5c8a9f59369cb92f52d95319",+            "width": 32,+            "height": 32+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=48&amp;height=48&amp;auto=webp&amp;s=f076c6434fb2d2f9075991810fd845c40fa73fc6",+            "width": 48,+            "height": 48+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=64&amp;height=64&amp;auto=webp&amp;s=85527145e0c4b754306a30df29e584fd16187636",+            "width": 64,+            "height": 64+          },+          {+            "url": "https://preview.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png?width=128&amp;height=128&amp;auto=webp&amp;s=b8843cdf82c3b741d7af057c14076dcd2621e811",+            "width": 128,+            "height": 128+          }+        ],+        "icon_format": "PNG",+        "icon_height": 2048,+        "penny_price": 0,+        "award_type": "global",+        "static_icon_url": "https://i.redd.it/award_images/t5_q0gj4/fpm0r5ryq1361_PolarHugs.png"+      }+    ],+    "awarders": [],+    "media_only": false,+    "can_gild": true,+    "spoiler": false,+    "locked": false,+    "author_flair_text": null,+    "treatment_tags": [],+    "visited": false,+    "removed_by": null,+    "num_reports": null,+    "distinguished": null,+    "subreddit_id": "t5_2fwo",+    "mod_reason_by": null,+    "removal_reason": null,+    "link_flair_background_color": "",+    "id": "ncnza3",+    "is_robot_indexable": true,+    "report_reasons": null,+    "author": "marcusthethinker",+    "discussion_type": null,+    "num_comments": 35,+    "send_replies": true,+    "whitelist_status": "all_ads",+    "contest_mode": false,+    "mod_reports": [],+    "author_patreon_flair": false,+    "author_flair_text_color": null,+    "permalink": "/r/<SUBREDDI>/comments/ncnza3/<SUBMISSION>/",+    "parent_whitelist_status": "all_ads",+    "stickied": false,+    "url": "https://EXAMPLE.com/",+    "subreddit_subscribers": 3372076,+    "created_utc": 1621042282.0,+    "num_crossposts": 1,+    "media": null,+    "is_video": false+  }+}
+ tests/data/types/subreddit-settings.json view
@@ -0,0 +1,59 @@+{+  "kind": "subreddit_settings",+  "data": {+    "default_set": true,+    "toxicity_threshold_chat_level": 1,+    "crowd_control_chat_level": 1,+    "disable_contributor_requests": false,+    "public_description": "",+    "subreddit_id": "t5_ga1qef",+    "allow_images": true,+    "free_form_reports": true,+    "domain": null,+    "show_media": true,+    "wiki_edit_age": 0,+    "submit_text": "",+    "allow_polls": true,+    "title": "",+    "collapse_deleted_comments": true,+    "wikimode": "disabled",+    "over_18": false,+    "allow_videos": true,+    "spoilers_enabled": true,+    "new_pinned_post_pns_enabled": true,+    "crowd_control_mode": false,+    "welcome_message_enabled": false,+    "welcome_message_text": null,+    "suggested_comment_sort": "qa",+    "restrict_posting": true,+    "original_content_tag_enabled": false,+    "description": "",+    "submit_link_label": "",+    "allow_galleries": true,+    "allow_post_crossposts": true,+    "spam_comments": "high",+    "public_traffic": false,+    "restrict_commenting": false,+    "crowd_control_level": 0,+    "submit_text_label": "",+    "all_original_content": false,+    "spam_selfposts": "low",+    "key_color": "",+    "language": "en",+    "wiki_edit_karma": 100,+    "hide_ads": false,+    "prediction_leaderboard_entry_type": 1,+    "header_hover_text": "",+    "allow_chat_post_creation": false,+    "allow_discovery": true,+    "exclude_banned_modqueue": false,+    "allow_predictions_tournament": false,+    "show_media_preview": true,+    "comment_score_hide_mins": 0,+    "subreddit_type": "gold_restricted",+    "spam_links": "low",+    "allow_predictions": false,+    "user_flair_pns_enabled": true,+    "content_options": "any"+  }+}
+ tests/data/types/subreddit.json view
@@ -0,0 +1,47 @@+{+  "kind": "t5",+  "data": {+    "banner_img": "",+    "submit_text_html": null,+    "user_is_banned": false,+    "wiki_enabled": null,+    "id": "2r0ij",+    "user_is_contributor": false,+    "submit_text": "",+    "display_name": "<SUBREDDIT_NAME>",+    "header_img": null,+    "description_html": "",+    "title": "<TITLE>",+    "collapse_deleted_comments": false,+    "public_description": "",+    "over18": false,+    "public_description_html": null,+    "icon_size": [256, 256],+    "suggested_comment_sort": "qa",+    "icon_img": "",+    "header_title": null,+    "description": "",+    "user_is_muted": false,+    "submit_link_label": null,+    "accounts_active": null,+    "public_traffic": false,+    "header_size": null,+    "subscribers": 11755132,+    "submit_text_label": null,+    "lang": "en",+    "key_color": "#ff4500",+    "name": "t5_2r0ij",+    "created": 1245284901.0,+    "url": "/r/<SUBREDDIT_NAME>/",+    "quarantine": false,+    "hide_ads": false,+    "created_utc": 1245256101.0,+    "banner_size": null,+    "user_is_moderator": false,+    "user_sr_theme_enabled": true,+    "comment_score_hide_mins": 0,+    "subreddit_type": "restricted",+    "submission_type": "any",+    "user_is_subscriber": true+  }+}
+ tests/data/types/traffic.json view
@@ -0,0 +1,174 @@+{+  "day": [+    [1624060800, 0, 0, 0],+    [1623974400, 0, 0, 0],+    [1623888000, 0, 0, 0],+    [1623801600, 0, 0, 0],+    [1623715200, 0, 0, 0],+    [1623628800, 0, 0, 0],+    [1623542400, 0, 0, 0],+    [1623456000, 0, 0, 0],+    [1623369600, 0, 0, 0],+    [1623283200, 0, 0, 0],+    [1623196800, 0, 0, 0],+    [1623110400, 0, 0, 0],+    [1623024000, 0, 0, 0],+    [1622937600, 1, 8, 0],+    [1622851200, 1, 11, 0],+    [1622764800, 0, 0, 0],+    [1622678400, 0, 0, 0],+    [1622592000, 0, 0, 0],+    [1622505600, 1, 14, 0],+    [1622419200, 0, 0, 0],+    [1622332800, 0, 0, 0],+    [1622246400, 0, 0, 0],+    [1622160000, 0, 0, 0],+    [1622073600, 2, 21, 0],+    [1621987200, 0, 0, 0],+    [1621900800, 0, 0, 0],+    [1621814400, 0, 0, 0],+    [1621728000, 0, 0, 0],+    [1621641600, 0, 0, 0],+    [1621555200, 0, 0, 0],+    [1621468800, 0, 0, 0],+    [1621382400, 0, 0, 0],+    [1621296000, 0, 0, 0],+    [1621209600, 0, 0, 0],+    [1621123200, 0, 0, 0],+    [1621036800, 0, 0, 0],+    [1620950400, 0, 0, 0],+    [1620864000, 0, 0, 0],+    [1620777600, 0, 0, 0],+    [1620691200, 0, 0, 0],+    [1620604800, 0, 0, 0],+    [1620518400, 0, 0, 0],+    [1620432000, 0, 0, 0],+    [1620345600, 0, 0, 0],+    [1620259200, 0, 0, 0],+    [1620172800, 0, 0, 0],+    [1620086400, 0, 0, 0],+    [1620000000, 0, 0, 0],+    [1619913600, 0, 0, 0],+    [1619827200, 0, 0, 0],+    [1619740800, 0, 0, 0],+    [1619654400, 0, 0, 0],+    [1619568000, 0, 0, 0],+    [1619481600, 0, 0, 0],+    [1619395200, 0, 0, 0],+    [1619308800, 0, 0, 0],+    [1619222400, 0, 0, 0]+  ],+  "hour": [+    [1624111200, 0, 0],+    [1624107600, 0, 0],+    [1624104000, 0, 0],+    [1624100400, 0, 0],+    [1624096800, 0, 0],+    [1624093200, 0, 0],+    [1624089600, 0, 0],+    [1624086000, 0, 0],+    [1624082400, 0, 0],+    [1624078800, 0, 0],+    [1624075200, 0, 0],+    [1624071600, 0, 0],+    [1624068000, 0, 0],+    [1624064400, 0, 0],+    [1624060800, 0, 0],+    [1624057200, 0, 0],+    [1624053600, 0, 0],+    [1624050000, 0, 0],+    [1624046400, 0, 0],+    [1624042800, 0, 0],+    [1624039200, 0, 0],+    [1624035600, 0, 0],+    [1624032000, 0, 0],+    [1624028400, 0, 0],+    [1624024800, 0, 0],+    [1624021200, 0, 0],+    [1624017600, 0, 0],+    [1624014000, 0, 0],+    [1624010400, 0, 0],+    [1624006800, 0, 0],+    [1624003200, 0, 0],+    [1623999600, 0, 0],+    [1623996000, 0, 0],+    [1623992400, 0, 0],+    [1623988800, 0, 0],+    [1623985200, 0, 0],+    [1623981600, 0, 0],+    [1623978000, 0, 0],+    [1623974400, 0, 0],+    [1623970800, 0, 0],+    [1623967200, 0, 0],+    [1623963600, 0, 0],+    [1623960000, 0, 0],+    [1623956400, 0, 0],+    [1623952800, 0, 0],+    [1623949200, 0, 0],+    [1623945600, 0, 0],+    [1623942000, 0, 0],+    [1623938400, 0, 0],+    [1623934800, 0, 0],+    [1623931200, 0, 0],+    [1623927600, 0, 0],+    [1623924000, 0, 0],+    [1623920400, 0, 0],+    [1623916800, 0, 0],+    [1623913200, 0, 0],+    [1623909600, 0, 0],+    [1623906000, 0, 0],+    [1623902400, 0, 0],+    [1623898800, 0, 0],+    [1623895200, 0, 0],+    [1623891600, 0, 0],+    [1623888000, 0, 0],+    [1623884400, 0, 0],+    [1623880800, 0, 0],+    [1623877200, 0, 0],+    [1623873600, 0, 0],+    [1623870000, 0, 0],+    [1623866400, 0, 0],+    [1623862800, 0, 0],+    [1623859200, 0, 0],+    [1623855600, 0, 0],+    [1623852000, 0, 0],+    [1623848400, 0, 0],+    [1623844800, 0, 0],+    [1623841200, 0, 0],+    [1623837600, 0, 0],+    [1623834000, 0, 0],+    [1623830400, 0, 0],+    [1623826800, 0, 0],+    [1623823200, 0, 0],+    [1623819600, 0, 0],+    [1623816000, 0, 0],+    [1623812400, 0, 0],+    [1623808800, 0, 0],+    [1623805200, 0, 0],+    [1623801600, 0, 0],+    [1623798000, 0, 0],+    [1623794400, 0, 0],+    [1623790800, 0, 0],+    [1623787200, 0, 0],+    [1623783600, 0, 0],+    [1623780000, 0, 0],+    [1623776400, 0, 0],+    [1623772800, 0, 0],+    [1623769200, 0, 0],+    [1623765600, 0, 0]+  ],+  "month": [+    [1622505600, 3, 61],+    [1619827200, 0, 0],+    [1617235200, 0, 0],+    [1614556800, 0, 0],+    [1612137600, 0, 0],+    [1609459200, 0, 0],+    [1606780800, 0, 0],+    [1604188800, 0, 0],+    [1601510400, 0, 0],+    [1598918400, 0, 0],+    [1596240000, 0, 0],+    [1593561600, 0, 0]+  ]+}
+ tests/data/types/trophy-list.json view
@@ -0,0 +1,259 @@+{+  "kind": "TrophyList",+  "data": {+    "trophies": [+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/thanos_spared-70.png",+          "name": "Spared",+          "url": "https://www.reddit.com/r/thanosdidnothingwrong/",+          "icon_40": "https://www.redditstatic.com/awards2/thanos_spared-40.png",+          "award_id": "2b",+          "id": "1w20p2",+          "description": null+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/alpha_user-70.png",+          "name": "Alpha Tester",+          "url": null,+          "icon_40": "https://www.redditstatic.com/awards2/alpha_user-40.png",+          "award_id": "29",+          "id": "1v9cjg",+          "description": null+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_comment-70.png",+          "name": "Inciteful Comment",+          "url": "/r/announcements/comments/827zqc/in_response_to_recent_reports_about_the_integrity/dv83xs6/?context=5#dv83xs6",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_comment-40.png",+          "award_id": "8",+          "id": "1uf5vo",+          "description": "2018-03-05"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/827zqc",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "1uf5tz",+          "description": "2018-03-05"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/rgexchange-70.png",+          "name": "redditgifts Exchanges",+          "url": "https://redditgifts.com/profiles/view/spez/",+          "icon_40": "https://www.redditstatic.com/awards2/rgexchange-40.png",+          "award_id": "1k",+          "id": "1teu74",+          "description": "2 Exchanges"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/elf-70.png",+          "name": "redditgifts Elf",+          "url": "https://redditgifts.com/elves/",+          "icon_40": "https://www.redditstatic.com/awards2/elf-40.png",+          "award_id": "1j",+          "id": "1sywxd",+          "description": "Since November 2017"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_comment-70.png",+          "name": "Inciteful Comment",+          "url": "/r/announcements/comments/59k22p/hey_its_reddits_totally_politically_neutral_ceo/d9929yb/?context=5#d9929yb",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_comment-40.png",+          "award_id": "8",+          "id": "1izjfq",+          "description": "2016-10-26"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/beta_team-70.png",+          "name": "Beta Team",+          "url": null,+          "icon_40": "https://www.redditstatic.com/awards2/beta_team-40.png",+          "award_id": "w",+          "id": "1gh8e9",+          "description": "Reddit for iOS"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/4x35a3",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "1f5ifn",+          "description": "2016-08-10"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_comment-70.png",+          "name": "Inciteful Comment",+          "url": "/r/announcements/comments/4ny59k/lets_talk_about_orlando/d480txj?context=5#d480txj",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_comment-40.png",+          "award_id": "8",+          "id": "1c6kx9",+          "description": "2016-06-13"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/4ny59k",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "1c6kuc",+          "description": "2016-06-13"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/3fx2au",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "wt7cq",+          "description": "2015-08-05"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/3djjxw",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "w0w18",+          "description": "2015-07-16"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/inciteful_link-70.png",+          "name": "Inciteful Link",+          "url": "/tb/3dautm",+          "icon_40": "https://www.redditstatic.com/awards2/inciteful_link-40.png",+          "award_id": "7",+          "id": "vy4q0",+          "description": "2015-07-14"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/best_comment-70.png",+          "name": "Best Comment",+          "url": "/r/IAmA/comments/3cxedn/i_am_steve_huffman_the_new_ceo_of_reddit_ama/cszv2lg?context=5#cszv2lg",+          "icon_40": "https://www.redditstatic.com/awards2/best_comment-40.png",+          "award_id": "4",+          "id": "vt6s4",+          "description": "2015-07-11"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/best_comment-70.png",+          "name": "Best Comment",+          "url": "/r/announcements/comments/3cucye/an_old_team_at_reddit/csz1fte?context=5#csz1fte",+          "icon_40": "https://www.redditstatic.com/awards2/best_comment-40.png",+          "award_id": "4",+          "id": "vrpju",+          "description": "2015-07-10"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/reddit_gold-70.png",+          "name": "reddit gold",+          "url": "/gold/about",+          "icon_40": "https://www.redditstatic.com/awards2/reddit_gold-40.png",+          "award_id": "v",+          "id": "vr3vt",+          "description": "Since July 2015"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/mold-participant-70.png",+          "name": "reddit mold",+          "url": "http://blog.reddit.com/2011/03/reddit-mold-is-now-live.html",+          "icon_40": "https://www.redditstatic.com/awards2/mold-participant-40.png",+          "award_id": "15",+          "id": "1r0kj",+          "description": null+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/represent-70.png",+          "name": "Rally Monkey",+          "url": "http://www.reddit.com/r/ColbertRally",+          "icon_40": "https://www.redditstatic.com/awards2/represent-40.png",+          "award_id": "11",+          "id": "12ahw",+          "description": "Century Club"+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/verified_email-70.png",+          "name": "Verified Email",+          "url": null,+          "icon_40": "https://www.redditstatic.com/awards2/verified_email-40.png",+          "award_id": "o",+          "id": "4zhv",+          "description": null+        }+      },+      {+        "kind": "t6",+        "data": {+          "icon_70": "https://www.redditstatic.com/awards2/combocommenter-70.png",+          "name": "ComboCommenter",+          "url": null,+          "icon_40": "https://www.redditstatic.com/awards2/combocommenter-40.png",+          "award_id": "6",+          "id": "12qg",+          "description": "2009-10-16"+        }+      }+    ]+  }+}
+ tests/data/types/upload-lease.json view
@@ -0,0 +1,35 @@+{+  "s3ModerationLease": {+    "action": "//reddit-subreddit-uploaded-media.s3-accelerate.amazonaws.com",+    "fields": [+      { "name": "acl", "value": "public-read" },+      {+        "name": "key",+        "value": "t5_xxxxxx/styles/image_widget_0000000000000.jpg"+      },+      {+        "name": "X-Amz-Credential",+        "value": "00000000000000000000/20210625/us-east-1/s3/aws4_request"+      },+      { "name": "X-Amz-Algorithm", "value": "AWS4-HMAC-SHA256" },+      { "name": "X-Amz-Date", "value": "20210625T111738Z" },+      { "name": "success_action_status", "value": "201" },+      { "name": "content-type", "value": "image/jpeg" },+      { "name": "x-amz-storage-class", "value": "STANDARD" },+      { "name": "x-amz-meta-ext", "value": "jpg" },+      {+        "name": "policy",+        "value": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+      },+      {+        "name": "X-Amz-Signature",+        "value": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+      },+      {+        "name": "x-amz-security-token",+        "value": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+      }+    ]+  },+  "websocketUrl": "wss://ws-aaaaaaaaaaaaaaaaa.wss.redditmedia.com/structured-styles/t5_xxxxxx-<USER>?m=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+}
+ tests/data/types/user-account.json view
@@ -0,0 +1,148 @@+{+  "is_employee": false,+  "seen_layout_switch": false,+  "has_visited_new_profile": false,+  "pref_no_profanity": true,+  "has_external_account": false,+  "pref_geopopular": "",+  "seen_redesign_modal": false,+  "pref_show_trending": true,+  "subreddit": {+    "default_set": true,+    "user_is_contributor": false,+    "banner_img": "",+    "restrict_posting": true,+    "user_is_banned": false,+    "free_form_reports": true,+    "community_icon": null,+    "show_media": true,+    "icon_color": "#0DD3BB",+    "user_is_muted": false,+    "display_name": "u_some-user",+    "header_img": null,+    "title": "",+    "coins": 0,+    "previous_names": [],+    "over_18": false,+    "icon_size": [256, 256],+    "primary_color": "",+    "icon_img": "https://www.redditstatic.com/avatars/avatar_default_10_0DD3BB.png",+    "description": "",+    "submit_link_label": "",+    "header_size": null,+    "restrict_commenting": false,+    "subscribers": 0,+    "submit_text_label": "",+    "is_default_icon": true,+    "link_flair_position": "",+    "display_name_prefixed": "u/some-user",+    "key_color": "",+    "name": "t5_4dekfj",+    "is_default_banner": true,+    "url": "/some/url",+    "quarantine": false,+    "banner_size": null,+    "user_is_moderator": true,+    "public_description": "",+    "link_flair_enabled": false,+    "disable_contributor_requests": false,+    "subreddit_type": "user",+    "user_is_subscriber": false+  },+  "pref_show_presence": true,+  "snoovatar_img": "",+  "snoovatar_size": null,+  "gold_expiration": null,+  "has_gold_subscription": false,+  "is_sponsor": false,+  "num_friends": 0,+  "features": {+    "mod_service_mute_writes": true,+    "promoted_trend_blanks": true,+    "show_amp_link": true,+    "chat": true,+    "mweb_link_tab": {+      "owner": "growth",+      "variant": "control_2",+      "experiment_id": 404+    },+    "is_email_permission_required": false,+    "mod_awards": true,+    "expensive_coins_package": true,+    "mweb_xpromo_revamp_v2": {+      "owner": "growth",+      "variant": "control_1",+      "experiment_id": 457+    },+    "awards_on_streams": true,+    "mweb_xpromo_modal_listing_click_daily_dismissible_ios": true,+    "chat_subreddit": true,+    "modlog_copyright_removal": true,+    "show_nps_survey": true,+    "do_not_track": true,+    "chat_user_settings": true,+    "mod_service_mute_reads": true,+    "mweb_xpromo_interstitial_comments_ios": true,+    "mweb_xpromo_modal_listing_click_daily_dismissible_android": true,+    "premium_subscriptions_table": true,+    "mweb_xpromo_interstitial_comments_android": true,+    "noreferrer_to_noopener": true,+    "chat_group_rollout": true,+    "resized_styles_images": true,+    "spez_modal": true,+    "mweb_sharing_clipboard": {+      "owner": "growth",+      "variant": "treatment_1",+      "experiment_id": 315+    }+  },+  "can_edit_name": false,+  "verified": true,+  "new_modmail_exists": null,+  "pref_autoplay": true,+  "coins": 0,+  "has_paypal_subscription": false,+  "has_subscribed_to_premium": false,+  "id": "ek3l42jf",+  "has_stripe_subscription": false,+  "oauth_client_id": "someid",+  "can_create_subreddit": true,+  "over_18": false,+  "is_gold": false,+  "is_mod": false,+  "awarder_karma": 0,+  "suspension_expiration_utc": null,+  "has_verified_email": true,+  "is_suspended": false,+  "pref_video_autoplay": true,+  "in_chat": true,+  "has_android_subscription": false,+  "in_redesign_beta": true,+  "icon_img": "https://www.redditstatic.com/avatars/avatar_default_10_0DD3BB.png",+  "has_mod_mail": false,+  "pref_nightmode": false,+  "awardee_karma": 0,+  "hide_from_robots": false,+  "password_set": true,+  "link_karma": 1,+  "force_password_reset": false,+  "total_karma": 1,+  "seen_give_award_tooltip": false,+  "inbox_count": 0,+  "seen_premium_adblock_modal": false,+  "pref_top_karma_subreddits": true,+  "has_mail": false,+  "pref_show_snoovatar": false,+  "name": "some-user",+  "pref_clickgadget": 5,+  "created": 1620590422.0,+  "gold_creddits": 0,+  "created_utc": 1620561622.0,+  "has_ios_subscription": false,+  "pref_show_twitter": false,+  "in_beta": false,+  "comment_karma": 0,+  "has_subscribed": false,+  "linked_identities": [],+  "seen_subreddit_chat_ftux": false+}
+ tests/data/types/widgets.json view
@@ -0,0 +1,239 @@+{+  "items": {+    "widget_1289lwl6zizcv": {+      "styles": { "headerColor": "#46d160", "backgroundColor": "#00a6a5" },+      "kind": "button",+      "description": "Things for you to click on",+      "buttons": [+        {+          "url": "https://old.reddit.com",+          "text": "Reddit",+          "kind": "text",+          "color": "#ea0027"+        },+        {+          "kind": "image",+          "url": "https://styles.redditmedia.com/t5_3nwlq/styles/image_widget_don0sv1wl9821.png",+          "text": "Image button",+          "height": 924,+          "width": 1228,+          "linkUrl": "https://news.ycombinator.com"+        }+      ],+      "descriptionHtml": "",+      "shortName": "Clickies",+      "id": "widget_1289lwl6zizcv"+    },+    "widget_1289m4mofpxpm": {+      "styles": { "headerColor": "#6b6031", "backgroundColor": "#014980" },+      "kind": "community-list",+      "data": [+        {+          "name": "redditdev",+          "isSubscribed": false,+          "iconUrl": "https://b.thumbs.redditmedia.com/7GVLmrH9CdZeqXceSEWkmL8_DSUKRGUfwMxnUNh8D8A.png",+          "subscribers": 18996,+          "primaryColor": "#666666",+          "type": "subreddit",+          "communityIcon": ""+        }+      ],+      "shortName": "Subreddits",+      "id": "widget_1289m4mofpxpm"+    },+    "widget_1289ln898iiyb": {+      "styles": { "headerColor": "#ff66ac", "backgroundColor": "#373c3f" },+      "kind": "textarea",+      "textHtml": "",+      "text": "",+      "shortName": "Title of text area",+      "id": "widget_1289ln898iiyb"+    },+    "widget_moderators-3nwlq": {+      "styles": { "headerColor": null, "backgroundColor": null },+      "kind": "moderators",+      "mods": [+        {+          "name": "<USERNAME>",+          "authorFlairType": "richtext",+          "authorFlairTextColor": "dark",+          "authorFlairBackgroundColor": "#dadada",+          "authorFlairRichText": [+            {+              "a": ":cake:",+              "u": "https://emoji.redditmedia.com/46kel8lf1guz_t5_3nqvj/cake",+              "e": "emoji"+            }+          ],+          "authorFlairText": ":cake:"+        }+      ],+      "totalMods": 2,+      "id": "widget_moderators-3nwlq"+    },+    "widget_1289lz1u7hkss": {+      "styles": { "headerColor": null, "backgroundColor": null },+      "kind": "image",+      "data": [+        {+          "url": "https://styles.redditmedia.com/t5_3nwlq/styles/image_widget_refcp6myl9821.jpg",+          "width": 1920,+          "linkUrl": "https://kishibashi.com",+          "height": 1080+        }+      ],+      "shortName": "WIDGET TITLE \\u2014 IMAGES",+      "id": "widget_1289lz1u7hkss"+    },+    "widget_1289hydnyc8ds": {+      "styles": { "headerColor": "#ffd635", "backgroundColor": "#bbbdbf" },+      "templates": {+        "5822985c-1f4b-11e8-9ddf-0e292b3c6f96": {+          "text": ":lettuce:",+          "richtext": [+            {+              "a": ":lettuce:",+              "u": "https://emoji.redditmedia.com/090gxn2ienj01_t5_3nwlq/lettuce",+              "e": "emoji"+            }+          ],+          "backgroundColor": "#dadada",+          "templateId": "5822985c-1f4b-11e8-9ddf-0e292b3c6f96",+          "textColor": "dark",+          "type": "richtext"+        }+      },+      "kind": "post-flair",+      "display": "list",+      "id": "widget_1289hydnyc8ds",+      "shortName": "My post flair widget",+      "order": ["5822985c-1f4b-11e8-9ddf-0e292b3c6f96"]+    },+    "widget_11pmh15aefiob": {+      "styles": { "headerColor": null, "backgroundColor": null },+      "kind": "menu",+      "data": [+        { "url": "https://github.com/praw-dev/praw", "text": "PRAW" },+        {+          "text": "Music",+          "children": [+            { "url": "https://kishibashi.com", "text": "Kishi Bashi" },+            {+              "url": "https://www.punchbrothers.com/",+              "text": "Punch Brothers"+            },+            {+              "url": "https://linquafranqa.bandcamp.com",+              "text": "Linqua Franqa"+            }+          ]+        }+      ],+      "id": "widget_11pmh15aefiob"+    },+    "widget_1289ed3kfelmx": {+      "styles": { "headerColor": "#000000", "backgroundColor": "#ffffff" },+      "kind": "calendar",+      "requiresSync": true,+      "shortName": "2019 Calendar",+      "googleCalendarId": "someid",+      "configuration": {+        "showDescription": false,+        "numEvents": 50,+        "showTime": true,+        "showLocation": false,+        "showTitle": false,+        "showDate": true+      },+      "data": [+        {+          "titleHtml": "",+          "allDay": true,+          "title": "Something on Friday",+          "startTime": 1546588800.0,+          "endTime": 1546675200.0+        },+        {+          "titleHtml": "",+          "allDay": false,+          "title": "Another event",+          "startTime": 1546975800.0,+          "endTime": 1546979400.0+        }+      ],+      "id": "widget_1289ed3kfelmx"+    },+    "widget_id-card-3nwlq": {+      "styles": { "headerColor": "", "backgroundColor": "" },+      "kind": "id-card",+      "description": "for my own tests.",+      "subscribersText": "subs",+      "currentlyViewingCount": 7,+      "subscribersCount": 1,+      "currentlyViewingText": "online",+      "shortName": "Where am I?",+      "id": "widget_id-card-3nwlq"+    },+    "widget_1289mc02ql90s": {+      "styles": { "headerColor": null, "backgroundColor": null },+      "kind": "custom",+      "imageData": [+        {+          "url": "https://styles.redditmedia.com/t5_3nwlq/styles/image_widget_4dt1o394s9821.jpg",+          "width": 1920,+          "name": "kishi-bashi",+          "height": 1080+        }+      ],+      "text": "# Heading\\n\\n*italics* and normal",+      "stylesheetUrl": "https://styles.redditmedia.com/t5_3nwlq/styles/customWidget-stylesheet-nptwivzbm9821.css",+      "height": 100,+      "textHtml": "",+      "shortName": "Custom: not visible on mobile!",+      "id": "widget_1289mc02ql90s",+      "css": ""+    },+    "widget_rules-3nwlq": {+      "styles": { "headerColor": null, "backgroundColor": null },+      "kind": "subreddit-rules",+      "display": "compact",+      "shortName": "rules",+      "data": [+        {+          "violationReason": "being bad one",+          "description": "This is a full description of rule 1",+          "createdUtc": 1526467021.0,+          "priority": 0,+          "descriptionHtml": "",+          "shortName": "Rule 1"+        },+        {+          "violationReason": "being bad two",+          "description": "This is a full description of rule 2",+          "createdUtc": 1526467034.0,+          "priority": 1,+          "descriptionHtml": "",+          "shortName": "Rule 2"+        }+      ],+      "id": "widget_rules-3nwlq"+    }+  },+  "layout": {+    "idCardWidget": "widget_id-card-3nwlq",+    "topbar": { "order": ["widget_11pmh15aefiob"] },+    "sidebar": {+      "order": [+        "widget_rules-3nwlq",+        "widget_1289ed3kfelmx",+        "widget_1289hydnyc8ds",+        "widget_1289ln898iiyb",+        "widget_1289lwl6zizcv",+        "widget_1289lz1u7hkss",+        "widget_1289m4mofpxpm",+        "widget_1289mc02ql90s"+      ]+    },+    "moderatorWidget": "widget_moderators-3nwlq"+  }+}
+ tests/data/types/wiki-revision-listing.json view
@@ -0,0 +1,54 @@+{+  "kind": "Listing",+  "data": {+    "modhash": "",+    "children": [+      {+        "timestamp": 1410669829.0,+        "reason": null,+        "author": {+          "kind": "t2",+          "data": {+            "name": "bob2",+            "is_friend": false,+            "created": 1260869194.0,+            "hide_from_robots": true,+            "created_utc": 1260840394.0,+            "link_karma": 65478,+            "comment_karma": 31839,+            "is_gold": false,+            "is_mod": true,+            "has_verified_email": true,+            "id": "3fk3l"+          }+        },+        "page": "faq",+        "id": "a9e563ba-3b86-11e4-ad8f-12313b0b1c29"+      },+      {+        "timestamp": 1365052093.0,+        "reason": null,+        "author": {+          "kind": "t2",+          "data": {+            "name": "bob",+            "is_friend": false,+            "created": 1288850222.0,+            "hide_from_robots": false,+            "created_utc": 1288821422.0,+            "link_karma": 11709,+            "comment_karma": 35803,+            "is_gold": true,+            "is_mod": true,+            "has_verified_email": true,+            "id": "3djje"+          }+        },+        "page": "faq",+        "id": "98b9b110-9ca2-11e2-b479-12313b0d4e76"+      }+    ],+    "after": "WikiRevision_3d97f4a0-512e-11e2-a43d-12313d16a9f2",+    "before": null+  }+}
+ tests/data/types/wikipage-settings.json view
@@ -0,0 +1,8 @@+{+  "kind": "wikipagesettings",+  "data": {+    "permlevel": 2,+    "editors": [],+    "listed": false+  }+}
+ tests/data/types/wikipage.json view
@@ -0,0 +1,25 @@+{+  "kind": "wikipage",+  "data": {+    "may_revise": false,+    "content_md": "Some stuff",+    "revision_date": 1367295727.0,+    "content_html": "",+    "revision_by": {+      "kind": "t2",+      "data": {+        "name": "<USERNAME>",+        "is_friend": false,+        "created": 1284640285.0,+        "hide_from_robots": false,+        "created_utc": 1284611485.0,+        "link_karma": 12,+        "comment_karma": 9,+        "is_gold": false,+        "is_mod": true,+        "has_verified_email": true,+        "id": "4cixf"+      }+    }+  }+}