packages feed

sigmacord (empty) → 1.0.0

raw patch · 39 files changed

+9274/−0 lines, 39 filesdep +MonadRandomdep +aesondep +async

Dependencies added: MonadRandom, aeson, async, base, base64-bytestring, bytestring, containers, data-default, emoji, http-api-data, http-client, iso8601-time, mtl, network, req, safe-exceptions, scientific, text, time, unliftio, unordered-containers, websockets, wuss

Files

+ LICENSE view
@@ -0,0 +1,674 @@+GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<https://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
+ README.md view
+ sigmacord.cabal view
@@ -0,0 +1,93 @@+cabal-version:       2.0
+name:                sigmacord
+version:             1.0.0
+description:         Sigmacord wraps Discord API and helps developers write Discord Bots in Haskell
+synopsis:            Write Discord Bots in Haskell
+homepage:            https://github.com/enginestein/Sigmacord
+bug-reports:         https://github.com/enginestein/Sigmacord/issues
+license:             GPL
+license-file:        LICENSE
+author:              Arya Praneil Pritesh
+maintainer:          aryapraneil@gmail.com
+copyright:           2023 Enginestein
+category:            Network
+build-type:          Simple
+tested-with:         GHC == 8.10.7
+                   , GHC == 9.2
+                   , GHC == 9.4
+extra-doc-files:     README.md
+
+source-repository head
+  type:                git
+  location:            https://github.com/enginestein/Sigmacord.git
+
+library
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  other-modules:
+    Paths_discord_haskell
+  autogen-modules:
+    Paths_discord_haskell
+  exposed-modules:
+      Sigmacord
+    , Sigmacord.Types
+    , Sigmacord.Handle
+    , Sigmacord.Interactions
+    , Sigmacord.Requests
+    , Sigmacord.Internal.Gateway
+    , Sigmacord.Internal.Gateway.Cache
+    , Sigmacord.Internal.Gateway.EventLoop
+    , Sigmacord.Internal.Rest
+    , Sigmacord.Internal.Rest.Prelude
+    , Sigmacord.Internal.Rest.HTTP
+    , Sigmacord.Internal.Rest.Invite
+    , Sigmacord.Internal.Rest.Emoji
+    , Sigmacord.Internal.Rest.User
+    , Sigmacord.Internal.Rest.Guild
+    , Sigmacord.Internal.Rest.Channel
+    , Sigmacord.Internal.Rest.Voice
+    , Sigmacord.Internal.Rest.Webhook
+    , Sigmacord.Internal.Rest.ApplicationCommands
+    , Sigmacord.Internal.Rest.Interactions
+    , Sigmacord.Internal.Rest.ScheduledEvents
+    , Sigmacord.Internal.Types
+    , Sigmacord.Internal.Types.Prelude
+    , Sigmacord.Internal.Types.Channel
+    , Sigmacord.Internal.Types.Events
+    , Sigmacord.Internal.Types.Gateway
+    , Sigmacord.Internal.Types.Guild
+    , Sigmacord.Internal.Types.User
+    , Sigmacord.Internal.Types.Embed
+    , Sigmacord.Internal.Types.ApplicationCommands
+    , Sigmacord.Internal.Types.Interactions
+    , Sigmacord.Internal.Types.Components
+    , Sigmacord.Internal.Types.Color
+    , Sigmacord.Internal.Types.Emoji
+    , Sigmacord.Internal.Types.RolePermissions
+    , Sigmacord.Internal.Types.ScheduledEvents
+                             
+  build-depends:
+    base == 4.14.* || == 4.15.* || == 4.16.* || == 4.17.*,
+    aeson >= 1.5 && < 1.6 || >= 2.0 && < 2.2,
+    async >=2.2 && <2.3,
+    bytestring >=0.10 && <0.12,
+    base64-bytestring >=1.1 && <1.3,
+    containers >=0.6 && <0.7,
+    data-default >=0.7 && <0.8,
+    emoji ==0.1.*,
+    http-client >=0.6 && <0.8,
+    iso8601-time >=0.1 && <0.2,
+    MonadRandom >=0.5 && <0.6,
+    req >=3.9 && <3.14,
+    safe-exceptions >=0.1 && <0.2,
+    text >=1.2 && <3,
+    time >=1.9 && <1.12,
+    websockets >=0.12 && <0.13,
+    network >=3.0.0.0 && <3.2.0.0,
+    wuss >=1.1 && <3,
+    mtl >=2.2 && <2.3,
+    unliftio >=0.2 && <0.3,
+    scientific >=0.3 && <0.4,
+    http-api-data >=0.4 && <0.6,
+    unordered-containers >=0.2.10.0 && <0.3

+ src/Sigmacord.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Discord
+  ( runDiscord
+  , restCall
+  , sendCommand
+  , readCache
+  , stopDiscord
+  , getGatewayLatency
+  , measureLatency
+
+  , DiscordHandler
+
+  , DiscordHandle
+  , Cache(..)
+  , RestCallErrorCode(..)
+  , RunDiscordOpts(..)
+  , FromJSON
+  , Request
+  , def
+  ) where
+
+import Prelude hiding (log)
+import Control.Exception (Exception)
+import Control.Monad.Reader (ReaderT, runReaderT, void, ask, liftIO, forever, asks)
+import Data.Aeson (FromJSON)
+import Data.Default (Default, def)
+import Data.IORef (writeIORef)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
+
+import UnliftIO (race, try, finally, SomeException, IOException, readIORef)
+import UnliftIO.Concurrent
+
+import Discord.Handle
+import Discord.Internal.Rest
+import Discord.Internal.Rest.User (UserRequest(GetCurrentUser))
+import Discord.Internal.Gateway
+
+
+
+type DiscordHandler = ReaderT DiscordHandle IO
+
+
+data RunDiscordOpts = RunDiscordOpts
+  { 
+    discordToken :: T.Text
+  , 
+    
+    discordOnStart :: DiscordHandler ()
+  , 
+    
+    discordOnEnd :: IO ()
+  , 
+    
+    discordOnEvent :: Event -> DiscordHandler ()
+  , 
+    discordOnLog :: T.Text -> IO ()
+  , 
+    discordForkThreadForEvents :: Bool
+  , 
+    discordGatewayIntent :: GatewayIntent
+  , 
+    discordEnableCache :: Bool
+  }
+
+
+instance Default RunDiscordOpts where
+  def = RunDiscordOpts { discordToken = ""
+                       , discordOnStart = pure ()
+                       , discordOnEnd = pure ()
+                       , discordOnEvent = \_ -> pure ()
+                       , discordOnLog = \_ -> pure ()
+                       , discordForkThreadForEvents = True
+                       , discordGatewayIntent = def
+                       , discordEnableCache = False
+                       }
+
+
+runDiscord :: RunDiscordOpts -> IO T.Text
+runDiscord opts = do
+  log <- newChan
+  logId <- liftIO $ startLogger (discordOnLog opts) log
+  (cache, cacheId) <- liftIO $ startCacheThread (discordEnableCache opts) log
+  (rest, restId) <- liftIO $ startRestThread (Auth (discordToken opts)) log
+  (gate, gateId) <- liftIO $ startGatewayThread (Auth (discordToken opts)) (discordGatewayIntent opts) cache log
+
+  libE <- newEmptyMVar
+
+  let handle = DiscordHandle { discordHandleRestChan = rest
+                             , discordHandleGateway = gate
+                             , discordHandleCache = cache
+                             , discordHandleLog = log
+                             , discordHandleLibraryError = libE
+                             , discordHandleThreads =
+                                 [ HandleThreadIdLogger logId
+                                 , HandleThreadIdRest restId
+                                 , HandleThreadIdCache cacheId
+                                 , HandleThreadIdGateway gateId
+                                 ]
+                             }
+
+  finally (runDiscordLoop handle opts)
+          (discordOnEnd opts >> runReaderT stopDiscord handle)
+
+
+runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO T.Text
+runDiscordLoop handle opts = do
+  resp <- liftIO $ writeRestCall (discordHandleRestChan handle) GetCurrentUser
+  case resp of
+    Left (RestCallInternalErrorCode c e1 e2) -> libError $
+             "HTTP Error Code " <> T.pack (show c) <> " " <> TE.decodeUtf8 e1
+                                                   <> " " <> TE.decodeUtf8 e2
+    Left (RestCallInternalHttpException e) -> libError ("HTTP Exception -  " <> T.pack (show e))
+    Left (RestCallInternalNoParse _ _) -> libError "Couldn't parse GetCurrentUser"
+    _ -> do me <- liftIO . runReaderT (try $ discordOnStart opts) $ handle
+            case me of
+              Left (e :: SomeException) -> libError ("discordOnStart handler stopped on an exception:\n\n" <> T.pack (show e))
+              Right _ -> loop
+ where
+   libError :: T.Text -> IO T.Text
+   libError msg = tryPutMVar (discordHandleLibraryError handle) msg >> pure msg
+
+   loop :: IO T.Text
+   loop = do next <- race (readMVar (discordHandleLibraryError handle))
+                          (readChan (gatewayHandleEvents (discordHandleGateway handle)))
+             case next of
+               Left err -> libError err
+               Right (Left err) -> libError (T.pack (show err))
+               Right (Right event) -> do
+                 let userEvent = userFacingEvent event
+                 let action = if discordForkThreadForEvents opts then void . forkIO
+                                                                 else id
+                 action $ do me <- liftIO . runReaderT (try $ discordOnEvent opts userEvent) $ handle
+                             case me of
+                               Left (e :: SomeException) -> writeChan (discordHandleLog handle)
+                                         ("eventhandler - crashed on [" <> T.pack (show userEvent) <> "] "
+                                          <> "          with error: "  <> T.pack (show e))
+                               Right _ -> pure ()
+                 loop
+
+
+data RestCallErrorCode = RestCallErrorCode Int T.Text T.Text
+  deriving (Show, Read, Eq, Ord)
+
+instance Exception RestCallErrorCode
+
+
+restCall :: (Request (r a), FromJSON a) => r a -> DiscordHandler (Either RestCallErrorCode a)
+restCall r = do h <- ask
+                empty <- isEmptyMVar (discordHandleLibraryError h)
+                if not empty
+                then pure (Left (RestCallErrorCode 400 "Library Stopped Working" ""))
+                else do
+                    resp <- liftIO $ writeRestCall (discordHandleRestChan h) r
+                    case resp of
+                      Right x -> pure (Right x)
+                      Left (RestCallInternalErrorCode c e1 e2) -> do
+                        pure (Left (RestCallErrorCode c (TE.decodeUtf8 e1) (TE.decodeUtf8 e2)))
+                      Left (RestCallInternalHttpException _) ->
+                        threadDelay (10 * 10^(6 :: Int)) >> restCall r
+                      Left (RestCallInternalNoParse err dat) -> do
+                        let formaterr = T.pack ("restcall - parse exception [" <> err <> "]"
+                                              <> " while handling" <> show dat)
+                        writeChan (discordHandleLog h) formaterr
+                        pure (Left (RestCallErrorCode 400 "Library Parse Exception" formaterr))
+
+
+sendCommand :: GatewaySendable -> DiscordHandler ()
+sendCommand e = do
+  h <- ask
+  writeChan (gatewayHandleUserSendables (discordHandleGateway h)) e
+  case e of
+    UpdateStatus opts -> liftIO $ writeIORef (gatewayHandleLastStatus (discordHandleGateway h)) (Just opts)
+    _ -> pure ()
+
+
+readCache :: DiscordHandler Cache
+readCache = do
+  h <- ask
+  merr <- readMVar (cacheHandleCache (discordHandleCache h))
+  case merr of
+    Left (c, _) -> pure c
+    Right c -> pure c
+
+
+
+stopDiscord :: DiscordHandler ()
+stopDiscord = do h <- ask
+                 _ <- tryPutMVar (discordHandleLibraryError h) "Library has closed"
+                 threadDelay (10^(6 :: Int) `div` 10)
+                 mapM_ (killThread . toId) (discordHandleThreads h)
+  where toId t = case t of
+                   HandleThreadIdRest a -> a
+                   HandleThreadIdGateway a -> a
+                   HandleThreadIdCache a -> a
+                   HandleThreadIdLogger a -> a
+
+
+startLogger :: (T.Text -> IO ()) -> Chan T.Text -> IO ThreadId
+startLogger handle logC = forkIO $ forever $
+  do me <- try $ readChan logC >>= handle
+     case me of
+       Right _ -> pure ()
+       Left (_ :: IOException) ->
+         
+         pure ()
+
+
+
+getGatewayLatency :: DiscordHandler NominalDiffTime
+getGatewayLatency = do
+  gw <- asks discordHandleGateway
+  (send1, send2) <- readIORef (gatewayHandleHeartbeatTimes gw)
+
+  ack <- readIORef (gatewayHandleHeartbeatAckTimes gw)
+
+  pure . diffUTCTime ack $ 
+    if ack > send1 
+      then send1
+      else send2
+
+
+
+
+
+measureLatency :: DiscordHandler NominalDiffTime
+measureLatency = do
+  startTime <- liftIO getCurrentTime
+  _ <- restCall GetCurrentUser
+  endTime <- liftIO getCurrentTime
+  pure $ diffUTCTime endTime startTime
+
+
+
+

+ src/Sigmacord/Handle.hs view
@@ -0,0 +1,37 @@+module Sigmacord.Handle
+  ( SigmacordHandle(..)
+  , HandleThreadId(..)
+  ) where
+
+import Control.Concurrent (ThreadId, Chan, MVar)
+import qualified Data.Text as T
+
+import Sigmacord.Internal.Rest (RestChanHandle(..))
+import Sigmacord.Internal.Gateway (GatewayHandle(..), CacheHandle(..))
+
+
+data HandleThreadId
+  = 
+    HandleThreadIdRest ThreadId
+  | 
+  HandleThreadIdCache ThreadId
+  | 
+  HandleThreadIdLogger ThreadId
+  | 
+  HandleThreadIdGateway ThreadId
+
+
+data SigmacordHandle = SigmacordHandle
+  { 
+    SigmacordHandleRestChan :: RestChanHandle
+  , 
+    SigmacordHandleGateway :: GatewayHandle
+  , 
+    SigmacordHandleCache :: CacheHandle
+  , 
+    SigmacordHandleThreads :: [HandleThreadId]
+  , 
+    SigmacordHandleLog :: Chan T.Text
+  , 
+    SigmacordHandleLibraryError :: MVar T.Text
+  }
+ src/Sigmacord/Interactions.hs view
@@ -0,0 +1,8 @@+module Sigmacord.Interactions
+  ( module Sigmacord.Internal.Types.ApplicationCommands,
+    module Sigmacord.Internal.Types.Interactions,
+  )
+where
+
+import Sigmacord.Internal.Types.ApplicationCommands
+import Sigmacord.Internal.Types.Interactions

+ src/Sigmacord/Internal/Gateway.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Sigmacord.Internal.Gateway
+  ( GatewayHandle(..)
+  , CacheHandle(..)
+  , GatewayException(..)
+  , Cache(..)
+  , startCacheThread
+  , startGatewayThread
+  , module Sigmacord.Internal.Types
+  ) where
+
+import Prelude hiding (log)
+import Control.Concurrent.Chan (newChan, dupChan, Chan)
+import Control.Concurrent (forkIO, ThreadId, newEmptyMVar, MVar)
+import Data.IORef (newIORef)
+import qualified Data.Text as T
+import Data.Time (getCurrentTime)
+
+import Sigmacord.Internal.Types (Auth, EventInternalParse, GatewayIntent)
+import Sigmacord.Internal.Gateway.EventLoop (connectionLoop, GatewayHandle(..), GatewayException(..))
+import Sigmacord.Internal.Gateway.Cache (cacheLoop, Cache(..), CacheHandle(..))
+
+
+startCacheThread :: Bool -> Chan T.Text -> IO (CacheHandle, ThreadId)
+startCacheThread isEnabled log = do
+  events <- newChan :: IO (Chan (Either GatewayException EventInternalParse))
+  cache <- newEmptyMVar :: IO (MVar (Either (Cache, GatewayException) Cache))
+  let cacheHandle = CacheHandle events cache
+  tid <- forkIO $ cacheLoop isEnabled cacheHandle log
+  pure (cacheHandle, tid)
+
+
+
+startGatewayThread :: Auth -> GatewayIntent -> CacheHandle -> Chan T.Text -> IO (GatewayHandle, ThreadId)
+startGatewayThread auth intent cacheHandle log = do
+  events <- dupChan (cacheHandleEvents cacheHandle)
+  sends <- newChan
+  status <- newIORef Nothing
+  seqid <- newIORef 0
+  seshid <- newIORef ""
+  host <- newIORef "gateway.Sigmacord.gg"
+  currTime <- getCurrentTime
+  hbAcks <- newIORef currTime
+  hbSends <- newIORef (currTime, currTime)
+  let gatewayHandle = GatewayHandle events sends status seqid seshid host hbAcks hbSends
+  tid <- forkIO $ connectionLoop auth intent gatewayHandle log
+  pure (gatewayHandle, tid)

+ src/Sigmacord/Internal/Gateway/Cache.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Sigmacord.Internal.Gateway.Cache where
+
+import Prelude hiding (log)
+import Control.Monad (forever, join)
+import Control.Concurrent.MVar
+import Control.Concurrent.Chan
+import Data.Foldable (foldl')
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Gateway.EventLoop
+
+data Cache = Cache
+     { cacheCurrentUser :: !User
+     , cacheDMChannels :: !(M.Map ChannelId Channel)
+     , cacheGuilds :: !(M.Map GuildId (Maybe (Guild, Maybe GuildCreateData)))
+     , cacheChannels :: !(M.Map ChannelId Channel)
+     , cacheApplication :: !PartialApplication
+     } deriving (Show)
+
+data CacheHandle = CacheHandle
+  { cacheHandleEvents :: Chan (Either GatewayException EventInternalParse)
+  , cacheHandleCache  :: MVar (Either (Cache, GatewayException) Cache)
+  }
+
+cacheLoop :: Bool -> CacheHandle -> Chan T.Text -> IO ()
+cacheLoop isEnabled cacheHandle log = do
+      ready <- readChan eventChan
+      case ready of
+        Right (InternalReady _ user _ _ _ _ pApp) -> do
+          putMVar cache (Right (Cache user M.empty M.empty M.empty pApp))
+          loop
+        Right r ->
+          writeChan log ("cache - stopping cache - expected Ready event, but got " <> T.pack (show r))
+        Left e ->
+          writeChan log ("cache - stopping cache - gateway exception " <> T.pack (show e))
+  where
+  cache     = cacheHandleCache cacheHandle
+  eventChan = cacheHandleEvents cacheHandle
+
+  loop :: IO ()
+  loop = forever $ do
+    eventOrExcept <- readChan eventChan
+    if not isEnabled
+      then return ()
+      else do
+        minfo <- takeMVar cache
+        case minfo of
+          Left nope -> putMVar cache (Left nope)
+          Right info -> case eventOrExcept of
+                          Left e -> putMVar cache (Left (info, e))
+                          Right event -> putMVar cache $! Right $! adjustCache info event
+
+adjustCache :: Cache -> EventInternalParse -> Cache
+adjustCache minfo event = case event of
+  InternalReady _ _ gus _ _ _ pa -> minfo { cacheApplication = pa, cacheGuilds = M.union (cacheGuilds minfo) (M.fromList $ (\gu -> (idOnceAvailable gu, Nothing)) <$> gus) }
+
+  InternalGuildCreate guild guildData ->
+    let newChans = guildCreateChannels guildData
+        g = M.insert (guildId guild) (Just (guild, Just guildData)) (cacheGuilds minfo)
+        c = M.union
+              (M.fromList [ (channelId ch, ch) | ch <- newChans ])
+              (cacheChannels minfo)
+    in minfo { cacheGuilds = g, cacheChannels = c }
+  InternalGuildUpdate guild ->
+    let gs = M.alter (\case Just (Just (_, mCD)) -> Just (Just (guild, mCD)) ; _ -> Just (Just (guild, Nothing)); ) (guildId guild) $ cacheGuilds minfo
+    in minfo { cacheGuilds = gs }
+  InternalGuildDelete guild ->
+    let
+      toDelete = join $ cacheGuilds minfo M.!? idOnceAvailable guild
+      extraData = snd =<< toDelete
+      channels = maybe [] (fmap channelId . guildCreateChannels) extraData
+      g = M.delete (idOnceAvailable guild) (cacheGuilds minfo)
+      c = foldl' (flip M.delete) (cacheChannels minfo) channels
+    in minfo { cacheGuilds = g, cacheChannels = c }
+  InternalChannelCreate c ->
+    let cm = M.insert (channelId c) c (cacheChannels minfo)
+    in minfo { cacheChannels = cm }
+  InternalChannelUpdate c ->
+    let cm = M.insert (channelId c) c (cacheChannels minfo)
+    in minfo { cacheChannels = cm }
+  InternalChannelDelete c ->
+    let cm = M.delete (channelId c) (cacheChannels minfo)
+    in minfo { cacheChannels = cm }
+  _ -> minfo

+ src/Sigmacord/Internal/Gateway/EventLoop.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+module Sigmacord.Internal.Gateway.EventLoop where
+
+import Prelude hiding (log)
+
+import Control.Monad (forever, void)
+import Control.Monad.Random (getRandomR)
+import Control.Concurrent.Async (race)
+import Control.Concurrent.Chan
+import Control.Concurrent (threadDelay, killThread, forkIO)
+import Control.Exception.Safe (try, finally, SomeException)
+import Data.IORef
+import Data.Aeson (eitherDecode, encode)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.ByteString.Lazy as BL
+import Data.Time (getCurrentTime)
+
+import Wuss (runSecureClient)
+import Network.Socket (HostName)
+import Network.WebSockets (ConnectionException(..), Connection,
+                           receiveData, sendTextData, sendClose)
+
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Rest.Prelude (apiVersion)
+
+
+
+data GatewayHandle = GatewayHandle
+  { 
+    gatewayHandleEvents         :: Chan (Either GatewayException EventInternalParse),
+    
+    gatewayHandleUserSendables  :: Chan GatewaySendable,
+    
+    gatewayHandleLastStatus     :: IORef (Maybe UpdateStatusOpts),
+    
+    gatewayHandleLastSequenceId :: IORef Integer,
+    
+    gatewayHandleSessionId      :: IORef T.Text,
+    
+    
+    
+    
+    
+    gatewayHandleHostname       :: IORef HostName,
+    
+    gatewayHandleHeartbeatAckTimes    :: IORef UTCTime,
+    
+    gatewayHandleHeartbeatTimes       :: IORef (UTCTime, UTCTime)
+  }
+
+
+newtype GatewayException = GatewayExceptionIntent T.Text
+  deriving (Show)
+
+
+
+data LoopState = LoopStart
+               | LoopClosed
+               | LoopReconnect
+  deriving Show
+
+
+data SendablesData = SendablesData
+  { sendableConnection :: Connection
+  , librarySendables :: Chan GatewaySendableInternal
+  , startsendingUsers :: IORef Bool
+  , heartbeatInterval :: Integer
+  }
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+connectionLoop :: Auth -> GatewayIntent -> GatewayHandle -> Chan T.Text -> IO ()
+connectionLoop auth intent gatewayHandle log = outerloop LoopStart
+    where
+
+    
+    outerloop :: LoopState -> IO ()
+    outerloop state = do
+        gatewayHost <- readIORef (gatewayHandleHostname gatewayHandle)
+        mfirst <- firstmessage state 
+        case mfirst of
+          Nothing -> pure () 
+
+          Just message -> do
+              nextstate <- try (startOneConnection gatewayHost message)  
+              case nextstate :: Either SomeException LoopState of
+                Left _ -> do t <- getRandomR (3,20)
+                             threadDelay (t * (10^(6 :: Int)))
+                             writeChan log "gateway - trying to reconnect after failure(s)"
+                             outerloop LoopReconnect
+                Right n -> outerloop n
+
+    
+    
+    firstmessage :: LoopState -> IO (Maybe GatewaySendableInternal)
+    firstmessage state =
+      case state of
+        LoopStart -> pure $ Just $ Identify auth intent (0, 1)
+        LoopReconnect -> do seqId  <- readIORef (gatewayHandleLastSequenceId gatewayHandle)
+                            seshId <- readIORef (gatewayHandleSessionId gatewayHandle)
+                            if seshId == ""
+                            then do writeChan log "gateway - WARNING seshID was not set by READY?"
+                                    pure $ Just $ Identify auth intent (0, 1)
+                            else pure $ Just $ Resume auth seshId seqId
+        LoopClosed -> pure Nothing
+
+    startOneConnection
+      :: HostName
+      
+      
+      
+      -> GatewaySendableInternal
+      
+      -> IO LoopState
+    startOneConnection gatewayAddr message = runSecureClient gatewayAddr 443 ("/?v=" <> T.unpack apiVersion <>"&encoding=json") $ \conn -> do
+                        msg <- getPayload conn log
+                        case msg of
+                            Right (Hello interval) -> do
+                                
+                                internal <- newChan :: IO (Chan GatewaySendableInternal)
+                                sendingUser <- newIORef False
+                                let sending = SendablesData { sendableConnection = conn
+                                                            , librarySendables = internal
+                                                            , startsendingUsers = sendingUser
+                                                            , heartbeatInterval = interval
+                                                            }
+                                
+                                sendsId <- forkIO $ sendableLoop conn gatewayHandle sending log
+                                heart <- forkIO $ heartbeat sending (gatewayHandleHeartbeatTimes gatewayHandle) (gatewayHandleLastSequenceId gatewayHandle)
+                                writeChan internal message
+
+                                
+                                finally (runEventLoop gatewayHandle sending log)
+                                        (killThread heart >> killThread sendsId)
+
+                            _ -> do
+                                writeChan log "gateway - WARNING could not connect. Expected hello"
+                                sendClose conn ("expected hello" :: BL.ByteString)
+                                void $ forever $ void (receiveData conn :: IO BL.ByteString)
+                                
+                                
+                                
+                                threadDelay (3 * (10^(6 :: Int)))
+                                pure LoopStart
+
+
+
+runEventLoop :: GatewayHandle -> SendablesData -> Chan T.Text -> IO LoopState
+runEventLoop thehandle sendablesData log = do loop
+  where
+  eventChan :: Chan (Either GatewayException EventInternalParse)
+  eventChan = gatewayHandleEvents thehandle
+
+  
+  loop = do
+    eitherPayload <- getPayloadTimeout sendablesData log
+    case eitherPayload :: Either ConnectionException GatewayReceivable of
+
+      Right (Dispatch event sq) -> do 
+                                      writeIORef (gatewayHandleLastSequenceId thehandle) sq
+                                      writeChan eventChan (Right event) 
+                                      case event of
+                                        (InternalReady _ _ _ seshID resumeHost _ _) -> do
+                                            writeIORef (gatewayHandleSessionId thehandle) seshID
+                                            writeIORef (gatewayHandleHostname thehandle) resumeHost
+                                        _ -> writeIORef (startsendingUsers sendablesData) True
+                                      loop
+      Right (Hello _interval) -> do writeChan log "eventloop - unexpected hello"
+                                    loop
+      Right (HeartbeatRequest sq) -> do writeIORef (gatewayHandleLastSequenceId thehandle) sq
+                                        sendHeartbeat sendablesData (gatewayHandleHeartbeatTimes thehandle) sq
+                                        loop
+      Right (InvalidSession retry) -> pure $ if retry then LoopReconnect else LoopStart
+      Right Reconnect        -> pure LoopReconnect
+      Right HeartbeatAck     -> do
+        currTime <- getCurrentTime
+        _ <- atomicModifyIORef' (gatewayHandleHeartbeatAckTimes thehandle) (dupe . const currTime)
+        loop
+      Right (ParseError _)   -> loop  
+
+      Left (CloseRequest code str) -> case code of
+          
+          
+          
+          1000 -> pure LoopReconnect
+          1001 -> pure LoopReconnect
+          4000 -> pure LoopReconnect
+          4006 -> pure LoopStart
+          4007 -> pure LoopStart
+          4014 -> do writeChan eventChan (Left (GatewayExceptionIntent $
+                           "Tried to declare an unauthorized GatewayIntent. " <>
+                           "Use the Sigmacord app manager to authorize by following: " <>
+                           "https://github.com/Sigmacord-haskell/Sigmacord-haskell/blob/master/docs/intents.md"))
+                     pure LoopClosed
+          _ -> do writeChan log ("gateway - unknown websocket close code " <> T.pack (show code)
+                                  <> " [" <> TE.decodeUtf8 (BL.toStrict str) <> "]. Consider opening an issue "
+                                  <> "https://github.com/Sigmacord-haskell/Sigmacord-haskell/issues")
+                  pure LoopStart
+      Left _ -> pure LoopReconnect
+
+
+
+getPayloadTimeout :: SendablesData -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable)
+getPayloadTimeout sendablesData log = do
+  let interval = heartbeatInterval sendablesData
+  res <- race (threadDelay (fromInteger ((interval * 1000 * 3) `div` 2)))
+              (getPayload (sendableConnection sendablesData) log)
+  case res of
+    Left () -> pure (Right Reconnect)
+    Right other -> pure other
+
+
+getPayload :: Connection -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable)
+getPayload conn log = try $ do
+  msg' <- receiveData conn
+  case eitherDecode msg' of
+    Right msg -> pure msg
+    Left  err -> do writeChan log ("gateway - received exception [" <> T.pack err <> "]"
+                                      <> " while decoding " <> TE.decodeUtf8 (BL.toStrict msg'))
+                    pure (ParseError (T.pack err))
+
+
+heartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> IORef Integer -> IO ()
+heartbeat sendablesData sendTimes seqKey = do
+  threadDelay (3 * 10^(6 :: Int))
+  forever $ do
+    num <- readIORef seqKey
+    sendHeartbeat sendablesData sendTimes num
+    threadDelay (fromInteger (heartbeatInterval sendablesData * 1000))
+
+sendHeartbeat :: SendablesData -> IORef (UTCTime, UTCTime) -> Integer -> IO ()
+sendHeartbeat sendablesData sendTimes seqKey = do
+  currTime <- getCurrentTime
+  _ <- atomicModifyIORef' sendTimes (dupe . (currTime,) . fst)
+  writeChan (librarySendables sendablesData) (Heartbeat seqKey)
+
+
+sendableLoop :: Connection -> GatewayHandle -> SendablesData -> Chan T.Text -> IO ()
+sendableLoop conn ghandle sendablesData _log = sendLoop
+  where
+  sendLoop = do
+   
+      threadDelay $ round ((10^(6 :: Int)) * (62 / 120) :: Double)
+   
+      payload <- race nextLibrary nextUser
+      sendTextData conn (either encode encode payload)
+      sendLoop
+
+  
+  nextLibrary :: IO GatewaySendableInternal
+  nextLibrary = readChan (librarySendables sendablesData)
+
+  
+  nextUser :: IO GatewaySendable
+  nextUser = do usersending <- readIORef (startsendingUsers sendablesData)
+                if usersending
+                then readChan (gatewayHandleUserSendables ghandle)
+                else threadDelay (4 * (10^(6::Int))) >> nextUser
+
+dupe :: a -> (a, a)
+dupe a = (a, a)

+ src/Sigmacord/Internal/Rest.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings  #-}
+
+module Sigmacord.Internal.Rest
+  ( module Sigmacord.Internal.Types
+  , RestChanHandle(..)
+  , Request(..)
+  , writeRestCall
+  , startRestThread
+  , RestCallInternalException(..)
+  ) where
+
+import Prelude hiding (log)
+import Data.Aeson (FromJSON, eitherDecode)
+import Control.Concurrent.Chan
+import Control.Concurrent.MVar
+import Control.Concurrent (forkIO, ThreadId)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+
+
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Rest.HTTP
+
+
+data RestChanHandle = RestChanHandle
+      { restHandleChan :: Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString))
+      }
+
+
+startRestThread :: Auth -> Chan T.Text -> IO (RestChanHandle, ThreadId)
+startRestThread auth log = do
+  c <- newChan
+  tid <- forkIO $ restLoop auth c log
+  pure (RestChanHandle c, tid)
+
+
+writeRestCall :: (Request (r a), FromJSON a) => RestChanHandle -> r a -> IO (Either RestCallInternalException a)
+writeRestCall c req = do
+  m <- newEmptyMVar
+  writeChan (restHandleChan c) (majorRoute req, jsonRequest req, m)
+  r <- readMVar m
+  pure $ case eitherDecode <$> r of
+    Right (Right o) -> Right o
+    (Right (Left er)) -> Left (RestCallInternalNoParse er (case r of
+      Right x -> x
+      Left _ -> ""))
+    Left e -> Left e
+
+

+ src/Sigmacord/Internal/Rest/ApplicationCommands.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Sigmacord.Internal.Rest.ApplicationCommands where
+
+import Data.Aeson (Value)
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Types.ApplicationCommands
+    ( ApplicationCommandPermissions,
+      GuildApplicationCommandPermissions(GuildApplicationCommandPermissions),
+      EditApplicationCommand,
+      CreateApplicationCommand,
+      ApplicationCommand )
+import Network.HTTP.Req as R
+
+instance Request (ApplicationCommandRequest a) where
+  jsonRequest = applicationCommandJsonRequest
+  majorRoute = applicationCommandMajorRoute
+
+
+data ApplicationCommandRequest a where
+  
+  GetGlobalApplicationCommands :: ApplicationId
+                               -> ApplicationCommandRequest [ApplicationCommand]
+  
+  
+  
+  CreateGlobalApplicationCommand :: ApplicationId
+                                 -> CreateApplicationCommand
+                                 -> ApplicationCommandRequest ApplicationCommand
+  
+  GetGlobalApplicationCommand :: ApplicationId
+                              -> ApplicationCommandId
+                              -> ApplicationCommandRequest ApplicationCommand
+  
+  
+  
+  EditGlobalApplicationCommand :: ApplicationId
+                               -> ApplicationCommandId
+                               -> EditApplicationCommand
+                               -> ApplicationCommandRequest ApplicationCommand
+  
+  DeleteGlobalApplicationCommand :: ApplicationId
+                                 -> ApplicationCommandId
+                                 -> ApplicationCommandRequest ()
+  
+  
+  
+  BulkOverWriteGlobalApplicationCommand :: ApplicationId
+                                        -> [CreateApplicationCommand]
+                                        -> ApplicationCommandRequest ()
+  
+  GetGuildApplicationCommands :: ApplicationId
+                              -> GuildId
+                              -> ApplicationCommandRequest [ApplicationCommand]
+  
+  
+  
+  
+  
+  CreateGuildApplicationCommand :: ApplicationId
+                                -> GuildId
+                                -> CreateApplicationCommand
+                                -> ApplicationCommandRequest ApplicationCommand
+  
+  GetGuildApplicationCommand :: ApplicationId
+                             -> GuildId
+                             -> ApplicationCommandId
+                             -> ApplicationCommandRequest ApplicationCommand
+  
+  
+  EditGuildApplicationCommand :: ApplicationId
+                              -> GuildId
+                              -> ApplicationCommandId
+                              -> CreateApplicationCommand
+                              -> ApplicationCommandRequest ApplicationCommand
+  
+  DeleteGuildApplicationCommand :: ApplicationId
+                                -> GuildId
+                                -> ApplicationCommandId
+                                -> ApplicationCommandRequest ()
+  
+  
+  
+  BulkOverWriteGuildApplicationCommand :: ApplicationId
+                                       -> GuildId
+                                       -> [CreateApplicationCommand]
+                                       -> ApplicationCommandRequest ()
+  
+  GetGuildApplicationCommandPermissions :: ApplicationId
+                                        -> GuildId
+                                        -> ApplicationCommandRequest GuildApplicationCommandPermissions
+  
+  GetApplicationCommandPermissions :: ApplicationId
+                                   -> GuildId
+                                   -> ApplicationCommandId
+                                   -> ApplicationCommandRequest GuildApplicationCommandPermissions
+  
+  
+  
+  
+  
+  
+  
+  EditApplicationCommandPermissions :: ApplicationId
+                                    -> GuildId
+                                    -> ApplicationCommandId
+                                    -> [ApplicationCommandPermissions]
+                                    -> ApplicationCommandRequest GuildApplicationCommandPermissions
+
+
+applications :: ApplicationId -> R.Url 'R.Https
+applications s = baseUrl /: "applications" /~ s
+
+
+applicationCommandMajorRoute :: ApplicationCommandRequest a -> String
+applicationCommandMajorRoute a = case a of
+  (GetGlobalApplicationCommands aid) -> "get_glob_appcomm" <> show aid
+  (CreateGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid
+  (GetGlobalApplicationCommand aid _) -> "get_glob_appcomm" <> show aid
+  (EditGlobalApplicationCommand aid _ _) -> "write_glob_appcomm" <> show aid
+  (DeleteGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid
+  (BulkOverWriteGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid
+  (GetGuildApplicationCommands aid _) -> "get_appcomm" <> show aid
+  (CreateGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid
+  (GetGuildApplicationCommand aid _ _) -> "get_appcomm" <> show aid
+  (EditGuildApplicationCommand aid _ _ _) -> "write_appcomm" <> show aid
+  (DeleteGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid
+  (BulkOverWriteGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid
+  (GetGuildApplicationCommandPermissions aid _) -> "appcom_perm " <> show aid
+  (GetApplicationCommandPermissions aid _ _) -> "appcom_perm " <> show aid
+  (EditApplicationCommandPermissions aid _ _ _) -> "appcom_perm " <> show aid
+
+
+applicationCommandJsonRequest :: ApplicationCommandRequest a -> JsonRequest
+applicationCommandJsonRequest a = case a of
+  (GetGlobalApplicationCommands aid) ->
+    Get (applications aid /: "commands") mempty
+  (CreateGlobalApplicationCommand aid cac) ->
+    Post (applications aid /: "commands") (convert cac) mempty
+  (GetGlobalApplicationCommand aid aci) ->
+    Get (applications aid /: "commands" /~ aci) mempty
+  (EditGlobalApplicationCommand aid aci eac) ->
+    Patch (applications aid /: "commands" /~ aci) (convert eac) mempty
+  (DeleteGlobalApplicationCommand aid aci) ->
+    Delete (applications aid /: "commands" /~ aci) mempty
+  (BulkOverWriteGlobalApplicationCommand aid cacs) ->
+    Put (applications aid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty
+  (GetGuildApplicationCommands aid gid) ->
+    Get (applications aid /: "guilds" /~ gid /: "commands") mempty
+  (CreateGuildApplicationCommand aid gid cac) ->
+    Post (applications aid /: "guilds" /~ gid /: "commands") (convert cac) mempty
+  (GetGuildApplicationCommand aid gid aci) ->
+    Get (applications aid /: "guilds" /~ gid /: "commands" /~ aci) mempty
+  (EditGuildApplicationCommand aid gid aci eac) ->
+    Patch (applications aid /: "guilds" /~ gid /: "commands" /~ aci) (convert eac) mempty
+  (DeleteGuildApplicationCommand aid gid aci) ->
+    Delete (applications aid /: "guilds" /~ gid /: "commands" /~ aci) mempty
+  (BulkOverWriteGuildApplicationCommand aid gid cacs) ->
+    Put (applications aid /: "guilds" /~ gid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty
+  (GetGuildApplicationCommandPermissions aid gid) ->
+    Get (applications aid /: "guilds" /~ gid /: "commands" /: "permissions") mempty
+  (GetApplicationCommandPermissions aid gid cid) ->
+    Get (applications aid /: "guilds" /~ gid /: "commands" /~ cid /: "permissions") mempty
+  (EditApplicationCommandPermissions aid gid cid ps) ->
+    Put (applications aid /: "guilds" /~ gid /: "commands" /~ cid /: "permissions") (R.ReqBodyJson $ toJSON (GuildApplicationCommandPermissions cid aid gid ps)) mempty
+  where
+    convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)
+    convert = (pure @RestIO) . R.ReqBodyJson . toJSON

+ src/Sigmacord/Internal/Rest/Channel.hs view
@@ -0,0 +1,607 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.Channel
+  ( ChannelRequest(..)
+  , MessageDetailedOpts(..)
+  , AllowedMentions(..)
+  , ReactionTiming(..)
+  , MessageTiming(..)
+  , ChannelInviteOpts(..)
+  , ModifyChannelOpts(..)
+  , ChannelPermissionsOpts(..)
+  , GroupDMAddRecipientOpts(..)
+  , StartThreadOpts(..)
+  , StartThreadNoMessageOpts(..)
+  , ListThreads(..)
+  ) where
+
+
+import Data.Aeson
+import Data.Default (Default, def)
+import Data.Emoji (unicodeByName)
+import qualified Data.Text as T
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import Network.HTTP.Client (RequestBody (RequestBodyBS))
+import Network.HTTP.Client.MultipartFormData (partFileRequestBody, partBS)
+import Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+import Control.Monad (join)
+
+instance Request (ChannelRequest a) where
+  majorRoute = channelMajorRoute
+  jsonRequest = channelJsonRequest
+
+
+data ChannelRequest a where
+  
+  GetChannel                :: ChannelId -> ChannelRequest Channel
+  
+  ModifyChannel             :: ChannelId -> ModifyChannelOpts -> ChannelRequest Channel
+  
+  DeleteChannel             :: ChannelId -> ChannelRequest Channel
+  
+  GetChannelMessages        :: ChannelId -> (Int, MessageTiming) -> ChannelRequest [Message]
+  
+  GetChannelMessage         :: (ChannelId, MessageId) -> ChannelRequest Message
+  
+  CreateMessage             :: ChannelId -> T.Text -> ChannelRequest Message
+  
+  CreateMessageDetailed     :: ChannelId -> MessageDetailedOpts -> ChannelRequest Message
+  
+  CreateReaction            :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
+  
+  DeleteOwnReaction         :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
+  
+  DeleteUserReaction        :: (ChannelId, MessageId) -> UserId -> T.Text -> ChannelRequest ()
+  
+  DeleteSingleReaction      :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
+  
+  GetReactions              :: (ChannelId, MessageId) -> T.Text -> (Int, ReactionTiming) -> ChannelRequest [User]
+  
+  DeleteAllReactions        :: (ChannelId, MessageId) -> ChannelRequest ()
+  
+  EditMessage               :: (ChannelId, MessageId) -> MessageDetailedOpts
+                                                      -> ChannelRequest Message
+  
+  DeleteMessage             :: (ChannelId, MessageId) -> ChannelRequest ()
+  
+  BulkDeleteMessage         :: (ChannelId, [MessageId]) -> ChannelRequest ()
+  
+  EditChannelPermissions    :: ChannelId -> Either RoleId UserId -> ChannelPermissionsOpts -> ChannelRequest ()
+  
+  GetChannelInvites         :: ChannelId -> ChannelRequest Object
+  
+  CreateChannelInvite       :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite
+  
+  DeleteChannelPermission   :: ChannelId -> Either RoleId UserId -> ChannelRequest ()
+  
+  TriggerTypingIndicator    :: ChannelId -> ChannelRequest ()
+  
+  GetPinnedMessages         :: ChannelId -> ChannelRequest [Message]
+  
+  AddPinnedMessage          :: (ChannelId, MessageId) -> ChannelRequest ()
+  
+  DeletePinnedMessage       :: (ChannelId, MessageId) -> ChannelRequest ()
+  
+  GroupDMAddRecipient       :: ChannelId -> GroupDMAddRecipientOpts -> ChannelRequest ()
+  
+  GroupDMRemoveRecipient    :: ChannelId -> UserId -> ChannelRequest ()
+  
+  StartThreadFromMessage    :: ChannelId -> MessageId -> StartThreadOpts -> ChannelRequest Channel
+  
+  StartThreadNoMessage      :: ChannelId -> StartThreadNoMessageOpts -> ChannelRequest Channel
+  
+  JoinThread                :: ChannelId -> ChannelRequest ()
+  
+  AddThreadMember           :: ChannelId -> UserId -> ChannelRequest ()
+  
+  LeaveThread               :: ChannelId -> ChannelRequest ()
+  
+  RemoveThreadMember        :: ChannelId -> UserId -> ChannelRequest ()
+  
+  GetThreadMember           :: ChannelId -> UserId -> ChannelRequest ThreadMember
+  
+  ListThreadMembers         :: ChannelId -> ChannelRequest [ThreadMember]
+  
+  
+  
+  
+  ListPublicArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads
+  
+  
+  
+  
+  ListPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads
+  
+  
+  
+  
+  ListJoinedPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads
+
+
+
+data MessageDetailedOpts = MessageDetailedOpts
+  { 
+    messageDetailedContent                  :: T.Text
+  , 
+    messageDetailedTTS                      :: Bool
+  , 
+    messageDetailedEmbeds                   :: Maybe [CreateEmbed]
+  , 
+    messageDetailedFile                     :: Maybe (T.Text, B.ByteString)
+  , 
+    messageDetailedAllowedMentions          :: Maybe AllowedMentions
+  , 
+    messageDetailedReference                :: Maybe MessageReference
+  , 
+    messageDetailedComponents               :: Maybe [ActionRow]
+  , 
+    messageDetailedStickerIds               :: Maybe [StickerId]
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default MessageDetailedOpts where
+  def = MessageDetailedOpts { messageDetailedContent         = ""
+                            , messageDetailedTTS             = False
+                            , messageDetailedEmbeds          = Nothing
+                            , messageDetailedFile            = Nothing
+                            , messageDetailedAllowedMentions = Nothing
+                            , messageDetailedReference       = Nothing
+                            , messageDetailedComponents      = Nothing
+                            , messageDetailedStickerIds      = Nothing
+                            }
+
+
+data ReactionTiming = BeforeReaction MessageId
+                    | AfterReaction MessageId
+                    | LatestReaction
+  deriving (Show, Read, Eq, Ord)
+
+reactionTimingToQuery :: ReactionTiming -> R.Option 'R.Https
+reactionTimingToQuery t = case t of
+  (BeforeReaction snow) -> "before" R.=: show snow
+  (AfterReaction snow) -> "after"  R.=: show snow
+  LatestReaction -> mempty
+
+
+
+
+data MessageTiming = AroundMessage MessageId
+                   | BeforeMessage MessageId
+                   | AfterMessage MessageId
+                   | LatestMessages
+  deriving (Show, Read, Eq, Ord)
+
+messageTimingToQuery :: MessageTiming -> R.Option 'R.Https
+messageTimingToQuery t = case t of
+  (AroundMessage snow) -> "around" R.=: show snow
+  (BeforeMessage snow) -> "before" R.=: show snow
+  (AfterMessage snow) -> "after"  R.=: show snow
+  LatestMessages -> mempty
+
+
+data ChannelInviteOpts = ChannelInviteOpts
+  { 
+    channelInviteOptsMaxAgeSeconds          :: Maybe Integer
+  , 
+    channelInviteOptsMaxUsages              :: Maybe Integer
+  , 
+    channelInviteOptsIsTemporary            :: Maybe Bool
+  , 
+    
+    channelInviteOptsDontReuseSimilarInvite :: Maybe Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ChannelInviteOpts where
+  toJSON ChannelInviteOpts{..} = objectFromMaybes
+                         ["max_age" .=? channelInviteOptsMaxAgeSeconds,
+                          "max_uses" .=? channelInviteOptsMaxUsages,
+                          "temporary" .=? channelInviteOptsIsTemporary,
+                          "unique" .=? channelInviteOptsDontReuseSimilarInvite ]
+
+
+data ModifyChannelOpts = ModifyChannelOpts
+  { 
+    modifyChannelName                 :: Maybe T.Text
+  , 
+    modifyChannelPosition             :: Maybe Integer
+  , 
+    modifyChannelTopic                :: Maybe T.Text
+  , 
+    modifyChannelNSFW                 :: Maybe Bool
+  , 
+    
+    modifyChannelBitrate              :: Maybe Integer
+  , 
+    
+    
+    modifyChannelUserRateLimit        :: Maybe Integer
+  , 
+    modifyChannelUserLimit            :: Maybe Integer
+  , 
+    modifyChannelPermissionOverwrites :: Maybe [Overwrite]
+  , 
+    modifyChannelParentId             :: Maybe ChannelId
+  , 
+    modifyChannelDefaultAutoArchive   :: Maybe Integer
+  , 
+    modifyChannelThreadArchived       :: Maybe Bool
+  , 
+    
+    modifyChannelThreadAutoArchive    :: Maybe Integer
+  , 
+    
+    modifyChannelThreadLocked         :: Maybe Bool
+  , 
+    
+    modifyChannelThreadInvitable     :: Maybe Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default ModifyChannelOpts where
+  def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+instance ToJSON ModifyChannelOpts where
+  toJSON ModifyChannelOpts{..} = objectFromMaybes
+               ["name" .=? modifyChannelName,
+                "position" .=? modifyChannelPosition,
+                "topic" .=? modifyChannelTopic,
+                "nsfw" .=? modifyChannelNSFW,
+                "bitrate" .=? modifyChannelBitrate,
+                "rate_limit_per_user" .=? modifyChannelUserRateLimit,
+                "user_limit" .=? modifyChannelUserLimit,
+                "permission_overwrites" .=? modifyChannelPermissionOverwrites,
+                "parent_id" .=? modifyChannelParentId,
+                "default_auto_archive_duration" .=? modifyChannelDefaultAutoArchive,
+                "archived" .=? modifyChannelThreadArchived,
+                "auto_archive_duration" .=? modifyChannelThreadAutoArchive,
+                "locked" .=? modifyChannelThreadLocked,
+                "invitable" .=? modifyChannelThreadInvitable ]
+
+
+
+
+
+
+
+data ChannelPermissionsOpts = ChannelPermissionsOpts
+  { 
+    channelPermissionsOptsAllow :: Integer
+  , 
+    channelPermissionsOptsDeny :: Integer
+  } deriving (Show, Read, Eq, Ord)
+
+
+
+
+data GroupDMAddRecipientOpts = GroupDMAddRecipientOpts
+  { 
+    groupDMAddRecipientUserToAdd :: UserId
+  , 
+    groupDMAddRecipientUserToAddNickName :: T.Text
+  , 
+    
+    groupDMAddRecipientGDMJoinAccessToken :: T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+
+data StartThreadOpts = StartThreadOpts
+  { 
+    startThreadName :: T.Text
+  , 
+    
+    
+    startThreadAutoArchive :: Maybe Integer
+  , 
+    
+    startThreadRateLimit :: Maybe Integer
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON StartThreadOpts where
+  toJSON StartThreadOpts{..} = objectFromMaybes
+      [ "name" .== startThreadName
+      , "auto_archive_duration" .=? startThreadAutoArchive
+      , "rate_limit_per_user" .=? startThreadRateLimit
+      ]
+
+
+data StartThreadNoMessageOpts = StartThreadNoMessageOpts
+  { 
+    startThreadNoMessageBaseOpts :: StartThreadOpts
+  , 
+    
+    
+    
+    startThreadNoMessageType :: Integer
+  , 
+    
+    startThreadNoMessageInvitable :: Maybe Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON StartThreadNoMessageOpts where
+  toJSON StartThreadNoMessageOpts{..} = objectFromMaybes
+      [ "name" .== startThreadName startThreadNoMessageBaseOpts
+      , "auto_archive_duration" .=? startThreadAutoArchive startThreadNoMessageBaseOpts
+      , "rate_limit_per_user" .=? startThreadRateLimit startThreadNoMessageBaseOpts
+      , "type" .== startThreadNoMessageType
+      , "invitable" .=? startThreadNoMessageInvitable
+      ]
+
+
+
+data ListThreads = ListThreads
+  { 
+    listThreadsThreads :: [Channel]
+  , 
+    
+    listThreadsMembers :: [ThreadMember]
+  ,  
+    listThreadsHasMore :: Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ListThreads where
+  toJSON ListThreads{..} = object
+    [ ("threads", toJSON listThreadsThreads)
+    , ("members", toJSON listThreadsMembers)
+    , ("has_more", toJSON listThreadsHasMore)
+    ]
+
+instance FromJSON ListThreads where
+  parseJSON = withObject "ListThreads" $ \o ->
+    ListThreads <$> o .: "threads"
+                <*> o .: "members"
+                <*> o .: "has_more"
+
+channelMajorRoute :: ChannelRequest a -> String
+channelMajorRoute c = case c of
+  (GetChannel chan) ->                       "get_chan " <> show chan
+  (ModifyChannel chan _) ->                  "mod_chan " <> show chan
+  (DeleteChannel chan) ->                    "mod_chan " <> show chan
+  (GetChannelMessages chan _) ->                  "msg " <> show chan
+  (GetChannelMessage (chan, _)) ->            "get_msg " <> show chan
+  (CreateMessage chan _) ->                       "msg " <> show chan
+  (CreateMessageDetailed chan _) ->               "msg " <> show chan
+  (CreateReaction (chan, _) _) ->           "add_react " <> show chan
+  (DeleteOwnReaction (chan, _) _) ->            "react " <> show chan
+  (DeleteUserReaction (chan, _) _ _) ->         "react " <> show chan
+  (DeleteSingleReaction (chan, _) _) ->         "react " <> show chan
+  (GetReactions (chan, _) _ _) ->               "react " <> show chan
+  (DeleteAllReactions (chan, _)) ->             "react " <> show chan
+  (EditMessage (chan, _) _) ->                "get_msg " <> show chan
+  (DeleteMessage (chan, _)) ->                "get_msg " <> show chan
+  (BulkDeleteMessage (chan, _)) ->           "del_msgs " <> show chan
+  (EditChannelPermissions chan _ _) ->          "perms " <> show chan
+  (GetChannelInvites chan) ->                 "invites " <> show chan
+  (CreateChannelInvite chan _) ->             "invites " <> show chan
+  (DeleteChannelPermission chan _) ->           "perms " <> show chan
+  (TriggerTypingIndicator chan) ->                "tti " <> show chan
+  (GetPinnedMessages chan) ->                    "pins " <> show chan
+  (AddPinnedMessage (chan, _)) ->                 "pin " <> show chan
+  (DeletePinnedMessage (chan, _)) ->              "pin " <> show chan
+  (GroupDMAddRecipient chan _) ->             "groupdm " <> show chan
+  (GroupDMRemoveRecipient chan _) ->          "groupdm " <> show chan
+  (StartThreadFromMessage chan _ _) ->         "thread " <> show chan
+  (StartThreadNoMessage chan _) ->           "thread " <> show chan
+  (JoinThread chan) ->                         "thread " <> show chan
+  (AddThreadMember chan _) ->                  "thread " <> show chan
+  (LeaveThread chan) ->                        "thread " <> show chan
+  (RemoveThreadMember chan _) ->               "thread " <> show chan
+  (GetThreadMember chan _) ->                  "thread " <> show chan
+  (ListThreadMembers chan) ->                  "thread " <> show chan
+  (ListPublicArchivedThreads chan _) ->        "thread " <> show chan
+  (ListPrivateArchivedThreads chan _) ->       "thread " <> show chan
+  (ListJoinedPrivateArchivedThreads chan _) -> "thread " <> show chan
+
+cleanupEmoji :: T.Text -> T.Text
+cleanupEmoji emoji =
+  let noAngles = T.replace "<" "" (T.replace ">" "" emoji)
+      byName = T.pack <$> unicodeByName (T.unpack (T.replace ":" "" emoji))
+  in case (byName, T.stripPrefix ":" noAngles) of
+    (Just e, _) -> e
+    (_, Just a) -> "custom:" <> a
+    (_, Nothing) -> noAngles
+
+channels :: R.Url 'R.Https
+channels = baseUrl /: "channels"
+
+channelJsonRequest :: ChannelRequest r -> JsonRequest
+channelJsonRequest c = case c of
+  (GetChannel chan) ->
+      Get (channels /~ chan) mempty
+
+  (ModifyChannel chan patch) ->
+      Patch (channels /~ chan) (pure (R.ReqBodyJson patch)) mempty
+
+  (DeleteChannel chan) ->
+      Delete (channels /~ chan) mempty
+
+  (GetChannelMessages chan (n,timing)) ->
+      let n' = max 1 (min 100 n)
+          options = "limit" R.=: n' <> messageTimingToQuery timing
+      in Get (channels /~ chan /: "messages") options
+
+  (GetChannelMessage (chan, msg)) ->
+      Get (channels /~ chan /: "messages" /~ msg) mempty
+
+  (CreateMessage chan msg) ->
+      let content = ["content" .= msg]
+          body = pure $ R.ReqBodyJson $ object content
+      in Post (channels /~ chan /: "messages") body mempty
+
+  (CreateMessageDetailed chan msgOpts) ->
+    let fileUpload = messageDetailedFile msgOpts
+        filePart =
+          ( case fileUpload of
+              Nothing -> []
+              Just f ->
+                [ partFileRequestBody
+                    "file"
+                    (T.unpack $ fst f)
+                    (RequestBodyBS $ snd f)
+                ]
+          )
+            ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts))
+
+        payloadData =  objectFromMaybes $
+                        [ "content" .== messageDetailedContent msgOpts
+                        , "tts"     .== messageDetailedTTS msgOpts ] ++
+                        [ "embeds" .=? ((createEmbed <$>) <$> messageDetailedEmbeds msgOpts)
+                        , "allowed_mentions" .=? messageDetailedAllowedMentions msgOpts
+                        , "message_reference" .=? messageDetailedReference msgOpts
+                        , "components" .=? messageDetailedComponents msgOpts
+                        , "sticker_ids" .=? messageDetailedStickerIds msgOpts
+                        ]
+        payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData
+
+        body = R.reqBodyMultipart (payloadPart : filePart)
+      in Post (channels /~ chan /: "messages") body mempty
+
+  (CreateReaction (chan, msgid) emoji) ->
+      let e = cleanupEmoji emoji
+      in Put (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" )
+             R.NoReqBody mempty
+
+  (DeleteOwnReaction (chan, msgid) emoji) ->
+      let e = cleanupEmoji emoji
+      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" ) mempty
+
+  (DeleteUserReaction (chan, msgid) uID emoji) ->
+      let e = cleanupEmoji emoji
+      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /~ uID ) mempty
+
+  (DeleteSingleReaction (chan, msgid) emoji) ->
+    let e = cleanupEmoji emoji
+    in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) mempty
+
+  (GetReactions (chan, msgid) emoji (n, timing)) ->
+      let e = cleanupEmoji emoji
+          n' = max 1 (min 100 n)
+          options = "limit" R.=: n' <> reactionTimingToQuery timing
+      in Get (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) options
+
+  (DeleteAllReactions (chan, msgid)) ->
+      Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" ) mempty
+
+  
+  (EditMessage (chan, msg) msgOpts) ->
+    let fileUpload = messageDetailedFile msgOpts
+        filePart =
+          ( case fileUpload of
+              Nothing -> []
+              Just f ->
+                [ partFileRequestBody
+                    "file"
+                    (T.unpack $ fst f)
+                    (RequestBodyBS $ snd f)
+                ]
+          )
+            ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts))
+
+        payloadData =  objectFromMaybes $
+                        [ "content" .== messageDetailedContent msgOpts
+                        , "tts"     .== messageDetailedTTS msgOpts ] ++
+                        [ "embeds" .=? ((createEmbed <$>) <$> messageDetailedEmbeds msgOpts)
+                        , "allowed_mentions" .=? messageDetailedAllowedMentions msgOpts
+                        , "message_reference" .=? messageDetailedReference msgOpts
+                        , "components" .=? messageDetailedComponents msgOpts
+                        , "sticker_ids" .=? messageDetailedStickerIds msgOpts
+                        ]
+        payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData
+
+        body = R.reqBodyMultipart (payloadPart : filePart)
+      in Patch (channels /~ chan /: "messages" /~ msg) body mempty
+
+  (DeleteMessage (chan, msg)) ->
+      Delete (channels /~ chan /: "messages" /~ msg) mempty
+
+  (BulkDeleteMessage (chan, msgs)) ->
+      let body = pure . R.ReqBodyJson $ object ["messages" .= msgs]
+      in Post (channels /~ chan /: "messages" /: "bulk-delete") body mempty
+
+  (EditChannelPermissions chan overwriteId (ChannelPermissionsOpts a d)) ->
+      let body = R.ReqBodyJson $ object [("type", toJSON (either (const 0) (const 1) overwriteId :: Int))
+                                        ,("allow", toJSON a)
+                                        ,("deny", toJSON d)]
+      in Put (channels /~ chan /: "permissions" /~ either unId unId overwriteId) body mempty
+
+  (GetChannelInvites chan) ->
+      Get (channels /~ chan /: "invites") mempty
+
+  (CreateChannelInvite chan patch) ->
+      Post (channels /~ chan /: "invites") (pure (R.ReqBodyJson patch)) mempty
+
+  (DeleteChannelPermission chan overwriteId) ->
+      Delete (channels /~ chan /: "permissions" /~ either unId unId overwriteId) mempty
+
+  (TriggerTypingIndicator chan) ->
+      Post (channels /~ chan /: "typing") (pure R.NoReqBody) mempty
+
+  (GetPinnedMessages chan) ->
+      Get (channels /~ chan /: "pins") mempty
+
+  (AddPinnedMessage (chan, msg)) ->
+      Put (channels /~ chan /: "pins" /~ msg) R.NoReqBody mempty
+
+  (DeletePinnedMessage (chan, msg)) ->
+      Delete (channels /~ chan /: "pins" /~ msg) mempty
+
+  (GroupDMAddRecipient chan (GroupDMAddRecipientOpts uid nick tok)) ->
+      Put (channels /~ chan /~ chan /: "recipients" /~ uid)
+          (R.ReqBodyJson (object [ ("access_token", toJSON tok)
+                                 , ("nick", toJSON nick)]))
+          mempty
+
+  (GroupDMRemoveRecipient chan userid) ->
+      Delete (channels /~ chan /~ chan /: "recipients" /~ userid) mempty
+
+  (StartThreadFromMessage chan mid sto) ->
+      Post (channels /~ chan /: "messages" /~ mid /: "threads")
+           (pure $ R.ReqBodyJson $ toJSON sto)
+           mempty
+
+  (StartThreadNoMessage chan sto) ->
+      Post (channels /~ chan /: "messages" /: "threads")
+           (pure $ R.ReqBodyJson $ toJSON sto)
+           mempty
+
+  (JoinThread chan) ->
+      Put (channels /~ chan /: "thread-members" /: "@me")
+          R.NoReqBody mempty
+
+  (AddThreadMember chan uid) ->
+      Put (channels /~ chan /: "thread-members" /~ uid)
+          R.NoReqBody mempty
+
+  (LeaveThread chan) ->
+      Delete (channels /~ chan /: "thread-members" /: "@me")
+          mempty
+
+  (RemoveThreadMember chan uid) ->
+      Delete (channels /~ chan /: "thread-members" /~ uid)
+          mempty
+
+  (GetThreadMember chan uid) ->
+      Get (channels /~ chan /: "thread-members" /~ uid)
+          mempty
+
+  (ListThreadMembers chan) ->
+      Get (channels /~ chan /: "thread-members")
+          mempty
+
+  (ListPublicArchivedThreads chan (time, lim)) ->
+      Get (channels /~ chan /: "threads" /: "archived" /: "public")
+          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)
+
+  (ListPrivateArchivedThreads chan (time, lim)) ->
+      Get (channels /~ chan /: "threads" /: "archived" /: "private")
+          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)
+
+  (ListJoinedPrivateArchivedThreads chan (time, lim)) ->
+      Get (channels /~ chan /: "users" /: "@me" /: "threads" /: "archived" /: "private")
+          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)

+ src/Sigmacord/Internal/Rest/Emoji.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+
+module Sigmacord.Internal.Rest.Emoji
+  ( EmojiRequest (..),
+    ModifyGuildEmojiOpts (..),
+    parseEmojiImage,
+    parseStickerImage,
+    StickerRequest (..),
+    CreateGuildStickerOpts (..),
+    EditGuildStickerOpts (..)
+  )
+where
+
+import Data.Aeson
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+import Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+
+instance Request (EmojiRequest a) where
+  majorRoute = emojiMajorRoute
+  jsonRequest = emojiJsonRequest
+
+
+data EmojiRequest a where
+  
+  ListGuildEmojis :: GuildId -> EmojiRequest [Emoji]
+  
+  GetGuildEmoji :: GuildId -> EmojiId -> EmojiRequest Emoji
+  
+  CreateGuildEmoji :: GuildId -> T.Text -> Base64Image Emoji -> EmojiRequest Emoji
+  
+  ModifyGuildEmoji :: GuildId -> EmojiId -> ModifyGuildEmojiOpts -> EmojiRequest Emoji
+  
+  DeleteGuildEmoji :: GuildId -> EmojiId -> EmojiRequest ()
+
+data ModifyGuildEmojiOpts = ModifyGuildEmojiOpts
+  { modifyGuildEmojiName :: T.Text,
+    modifyGuildEmojiRoles :: [RoleId]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ModifyGuildEmojiOpts where
+  toJSON (ModifyGuildEmojiOpts name roles) =
+    object ["name" .= name, "roles" .= roles]
+
+
+
+
+
+
+
+
+
+
+parseEmojiImage :: B.ByteString -> Either T.Text (Base64Image Emoji)
+parseEmojiImage bs
+  | B.length bs > 256000        = Left "Cannot create emoji - File is larger than 256kb"
+  | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs)))
+  | otherwise                   = Left "Unsupported image format provided"
+
+emojiMajorRoute :: EmojiRequest a -> String
+emojiMajorRoute c = case c of
+  (ListGuildEmojis g) -> "emoji " <> show g
+  (GetGuildEmoji g _) -> "emoji " <> show g
+  (CreateGuildEmoji g _ _) -> "emoji " <> show g
+  (ModifyGuildEmoji g _ _) -> "emoji " <> show g
+  (DeleteGuildEmoji g _) -> "emoji " <> show g
+
+guilds :: R.Url 'R.Https
+guilds = baseUrl /: "guilds"
+
+emojiJsonRequest :: EmojiRequest r -> JsonRequest
+emojiJsonRequest c = case c of
+  (ListGuildEmojis g) -> Get (guilds /~ g /: "emojis") mempty
+  (GetGuildEmoji g e) -> Get (guilds /~ g /: "emojis" /~ e) mempty
+  (CreateGuildEmoji g name b64im) ->
+    Post
+      (guilds /~ g /: "emojis")
+      ( pure
+          ( R.ReqBodyJson
+              ( object
+                  [ "name" .= name,
+                    "image" .= b64im
+                    
+                  ]
+              )
+          )
+      )
+      mempty
+  (ModifyGuildEmoji g e o) ->
+    Patch
+      (guilds /~ g /: "emojis" /~ e)
+      (pure (R.ReqBodyJson o))
+      mempty
+  (DeleteGuildEmoji g e) -> Delete (guilds /~ g /: "emojis" /~ e) mempty
+
+
+
+
+
+
+parseStickerImage :: B.ByteString -> Either T.Text (Base64Image Sticker)
+parseStickerImage bs
+  | B.length bs > 512000
+  = Left "Cannot create sticker - File is larger than 512kb"
+  | Just "image/png" <- getMimeType bs
+  = Right (Base64Image "image/png" (TE.decodeUtf8 (B64.encode bs)))
+  | not (B.null bs) && B.head bs == 0x7b 
+  = Right (Base64Image "application/json" (TE.decodeUtf8 (B64.encode bs)))
+  | otherwise
+  = Left "Unsupported image format provided"
+
+
+data CreateGuildStickerOpts = CreateGuildStickerOpts
+  { guildStickerName :: T.Text,
+    guildStickerDescription :: T.Text,
+    guildStickerTags :: [T.Text],
+    guildStickerFile :: Base64Image Sticker
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON CreateGuildStickerOpts where
+  toJSON (CreateGuildStickerOpts name desc tags b64im) =
+    object
+      [ ("name", toJSON name),
+        ("description", toJSON desc),
+        ("tags", toJSON $ T.intercalate "," tags),
+        ("file", toJSON b64im)
+      ]
+
+
+data EditGuildStickerOpts = EditGuildStickerOpts
+  { editGuildStickerName :: Maybe T.Text,
+    editGuildStickerDescription :: Maybe T.Text,
+    editGuildStickerTags :: Maybe [T.Text]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EditGuildStickerOpts where
+  toJSON EditGuildStickerOpts {..} =
+    objectFromMaybes
+      [ "name" .=? editGuildStickerName,
+        "description" .=? editGuildStickerDescription,
+        "tags" .=? fmap (T.intercalate ",") editGuildStickerTags
+      ]
+
+instance Request (StickerRequest a) where
+  majorRoute = stickerMajorRoute
+  jsonRequest = stickerJsonRequest
+
+
+
+
+
+data StickerRequest a where
+  
+  GetSticker :: StickerId -> StickerRequest Sticker
+  
+  ListNitroStickerPacks :: StickerRequest [StickerPack]
+  
+  ListGuildStickers :: GuildId -> StickerRequest [Sticker]
+  
+  GetGuildSticker :: GuildId -> StickerId -> StickerRequest Sticker
+  
+  CreateGuildSticker :: GuildId -> CreateGuildStickerOpts -> StickerRequest Sticker
+  
+  ModifyGuildSticker :: GuildId -> StickerId -> EditGuildStickerOpts -> StickerRequest Sticker
+  
+  DeleteGuildSticker :: GuildId -> StickerId -> StickerRequest ()
+
+stickerMajorRoute :: StickerRequest a -> String
+stickerMajorRoute = \case
+  GetSticker gid -> "sticker " <> show gid
+  ListNitroStickerPacks -> "sticker"
+  ListGuildStickers gid -> "sticker " <> show gid
+  GetGuildSticker gid _ -> "sticker " <> show gid
+  CreateGuildSticker gid _ -> "sticker " <> show gid
+  ModifyGuildSticker gid _ _ -> "sticker " <> show gid
+  DeleteGuildSticker gid _ -> "sticker " <> show gid
+
+stickerJsonRequest :: StickerRequest a -> JsonRequest
+stickerJsonRequest = \case
+  GetSticker gid -> Get (baseUrl /: "stickers" /~ gid) mempty
+  ListNitroStickerPacks -> Get (baseUrl /: "sticker-packs") mempty
+  ListGuildStickers gid -> Get (stickersGuild gid) mempty
+  GetGuildSticker gid sid -> Get (stickersGuild gid /~ sid) mempty
+  CreateGuildSticker gid cgso -> Post (stickersGuild gid) (pure $ R.ReqBodyJson $ toJSON cgso) mempty
+  ModifyGuildSticker gid sid egso -> Patch (stickersGuild gid /~ sid) (pure $ R.ReqBodyJson egso) mempty
+  DeleteGuildSticker gid sid -> Delete (stickersGuild gid /~ sid) mempty
+  where
+    stickersGuild gid = baseUrl /: "guilds" /~ gid /: "stickers"

+ src/Sigmacord/Internal/Rest/Guild.hs view
@@ -0,0 +1,468 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.Guild
+  ( GuildRequest(..)
+  , CreateGuildChannelOpts(..)
+  , ModifyGuildOpts(..)
+  , AddGuildMemberOpts(..)
+  , ModifyGuildMemberOpts(..)
+  , GuildMembersTiming(..)
+  , CreateGuildBanOpts(..)
+  , ModifyGuildRoleOpts(..)
+  , CreateGuildIntegrationOpts(..)
+  , ModifyGuildIntegrationOpts(..)
+  ) where
+
+
+import Data.Aeson
+import Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+import qualified Data.Text as T
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+import Data.Default (Default(..))
+
+instance Request (GuildRequest a) where
+  majorRoute = guildMajorRoute
+  jsonRequest = guildJsonRequest
+
+
+data GuildRequest a where
+  
+  
+
+  
+  GetGuild                 :: GuildId -> GuildRequest Guild
+  
+  
+  ModifyGuild              :: GuildId -> ModifyGuildOpts -> GuildRequest Guild
+  
+  DeleteGuild              :: GuildId -> GuildRequest ()
+  
+  GetGuildChannels         :: GuildId -> GuildRequest [Channel]
+  
+  
+  
+  CreateGuildChannel       :: GuildId -> T.Text -> [Overwrite] -> CreateGuildChannelOpts -> GuildRequest Channel
+  
+  
+  
+  ModifyGuildChannelPositions      :: GuildId -> [(ChannelId,Int)] -> GuildRequest [Channel]
+  
+  GetGuildMember           :: GuildId -> UserId -> GuildRequest GuildMember
+  
+  ListGuildMembers         :: GuildId -> GuildMembersTiming -> GuildRequest [GuildMember]
+  
+  
+  
+  
+  AddGuildMember           :: GuildId -> UserId -> AddGuildMemberOpts
+                                      -> GuildRequest ()
+  
+  ModifyGuildMember        :: GuildId -> UserId -> ModifyGuildMemberOpts -> GuildRequest GuildMember
+  
+  ModifyCurrentUserNick    :: GuildId -> T.Text -> GuildRequest ()
+  
+  AddGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
+  
+  RemoveGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
+  
+  
+  RemoveGuildMember        :: GuildId -> UserId -> GuildRequest ()
+  
+  
+  GetGuildBans             :: GuildId -> GuildRequest [GuildBan]
+  
+  
+  GetGuildBan              :: GuildId -> UserId -> GuildRequest GuildBan
+  
+  
+  CreateGuildBan           :: GuildId -> UserId -> CreateGuildBanOpts -> GuildRequest ()
+  
+  
+  RemoveGuildBan           :: GuildId -> UserId -> GuildRequest ()
+  
+  
+  GetGuildRoles            :: GuildId -> GuildRequest [Role]
+  
+  
+  CreateGuildRole          :: GuildId -> ModifyGuildRoleOpts -> GuildRequest Role
+  
+  
+  
+  ModifyGuildRolePositions :: GuildId -> [(RoleId, Integer)] -> GuildRequest [Role]
+  
+  
+  ModifyGuildRole          :: GuildId -> RoleId -> ModifyGuildRoleOpts -> GuildRequest Role
+  
+  
+  DeleteGuildRole          :: GuildId -> RoleId -> GuildRequest ()
+  
+  
+  
+  GetGuildPruneCount       :: GuildId -> Integer -> GuildRequest Object
+  
+  
+  
+  BeginGuildPrune          :: GuildId -> Integer -> GuildRequest Object
+  
+  
+  GetGuildVoiceRegions     :: GuildId -> GuildRequest [VoiceRegion]
+  
+  
+  GetGuildInvites          :: GuildId -> GuildRequest [Invite]
+  
+  
+  GetGuildIntegrations     :: GuildId -> GuildRequest [Integration]
+  
+  
+  CreateGuildIntegration   :: GuildId -> IntegrationId -> CreateGuildIntegrationOpts -> GuildRequest ()
+  
+  
+  ModifyGuildIntegration   :: GuildId -> IntegrationId -> ModifyGuildIntegrationOpts
+                                      -> GuildRequest ()
+  
+  
+  DeleteGuildIntegration   :: GuildId -> IntegrationId -> GuildRequest ()
+  
+  SyncGuildIntegration     :: GuildId -> IntegrationId -> GuildRequest ()
+  
+  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget
+  
+  
+  
+  ModifyGuildWidget         :: GuildId -> GuildWidget -> GuildRequest GuildWidget
+  
+  GetGuildVanityURL        :: GuildId -> GuildRequest T.Text
+
+
+data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts
+  { modifyGuildIntegrationOptsExpireBehavior :: Integer
+  , modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
+  , modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ModifyGuildIntegrationOpts where
+  toJSON ModifyGuildIntegrationOpts{..} = objectFromMaybes
+         [ "expire_grace_period" .== modifyGuildIntegrationOptsExpireGraceSeconds
+         , "expire_behavior" .== modifyGuildIntegrationOptsExpireBehavior
+         , "enable_emoticons" .== modifyGuildIntegrationOptsEmoticonsEnabled ]
+
+
+newtype CreateGuildIntegrationOpts = CreateGuildIntegrationOpts
+  { createGuildIntegrationOptsType :: T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON CreateGuildIntegrationOpts where
+  toJSON CreateGuildIntegrationOpts{..} = objectFromMaybes
+                       ["type" .== createGuildIntegrationOptsType]
+
+
+data CreateGuildBanOpts = CreateGuildBanOpts
+  { createGuildBanOptsDeleteLastNMessages :: Maybe Int
+  , createGuildBanOptsReason              :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON CreateGuildBanOpts where
+  toJSON CreateGuildBanOpts{..} = objectFromMaybes
+                       [ "delete_message_days"
+                           .=? createGuildBanOptsDeleteLastNMessages
+                       , "reason" .=? createGuildBanOptsReason]
+
+
+data ModifyGuildRoleOpts = ModifyGuildRoleOpts
+  { modifyGuildRoleOptsName            :: Maybe T.Text
+  , modifyGuildRoleOptsPermissions     :: Maybe RolePermissions
+  , modifyGuildRoleOptsColor           :: Maybe SigmacordColor
+  , modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
+  , modifyGuildRoleOptsMentionable     :: Maybe Bool
+  , modifyGuildRoleOptsIcon            :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ModifyGuildRoleOpts where
+  toJSON ModifyGuildRoleOpts{..} = objectFromMaybes
+                       ["name" .=? modifyGuildRoleOptsName,
+                        "permissions" .=? modifyGuildRoleOptsPermissions,
+                        "color" .=? modifyGuildRoleOptsColor,
+                        "hoist" .=? modifyGuildRoleOptsSeparateSidebar,
+                        "mentionable" .=? modifyGuildRoleOptsMentionable,
+                        "icon" .=? modifyGuildRoleOptsIcon]
+
+
+data AddGuildMemberOpts = AddGuildMemberOpts
+  { addGuildMemberOptsAccessToken :: T.Text
+  , addGuildMemberOptsNickname    :: Maybe T.Text
+  , addGuildMemberOptsRoles       :: Maybe [RoleId]
+  , addGuildMemberOptsIsMuted     :: Maybe Bool
+  , addGuildMemberOptsIsDeafened  :: Maybe Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON AddGuildMemberOpts where
+  toJSON AddGuildMemberOpts{..} = objectFromMaybes
+                                  ["access_token" .== addGuildMemberOptsAccessToken,
+                                   "nick" .=? addGuildMemberOptsNickname,
+                                   "roles" .=? addGuildMemberOptsRoles,
+                                   "mute" .=? addGuildMemberOptsIsMuted,
+                                   "deaf" .=? addGuildMemberOptsIsDeafened]
+
+
+data ModifyGuildMemberOpts = ModifyGuildMemberOpts
+  { modifyGuildMemberOptsNickname      :: Maybe T.Text
+  , modifyGuildMemberOptsRoles         :: Maybe [RoleId]
+  , modifyGuildMemberOptsIsMuted       :: Maybe Bool
+  , modifyGuildMemberOptsIsDeafened    :: Maybe Bool
+  , modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
+  , modifyGuildMemberOptsTimeoutUntil  :: Maybe (Maybe UTCTime) 
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default ModifyGuildMemberOpts where
+  def = ModifyGuildMemberOpts Nothing Nothing Nothing Nothing Nothing Nothing
+
+instance ToJSON ModifyGuildMemberOpts where
+  toJSON ModifyGuildMemberOpts{..} = objectFromMaybes
+                                  ["nick" .=? modifyGuildMemberOptsNickname,
+                                   "roles" .=? modifyGuildMemberOptsRoles,
+                                   "mute" .=? modifyGuildMemberOptsIsMuted,
+                                   "deaf" .=? modifyGuildMemberOptsIsDeafened,
+                                   "channel_id" .=? modifyGuildMemberOptsMoveToChannel,
+                                   "communication_disabled_until" .=? modifyGuildMemberOptsTimeoutUntil]
+
+
+data CreateGuildChannelOpts
+  
+  = CreateGuildChannelOptsText {
+    createGuildChannelOptsTopic :: Maybe T.Text
+  , createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
+  , createGuildChannelOptsIsNSFW :: Maybe Bool
+  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
+  
+  | CreateGuildChannelOptsVoice {
+    createGuildChannelOptsBitrate :: Maybe Integer
+  , createGuildChannelOptsMaxUsers :: Maybe Integer
+  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
+  
+  | CreateGuildChannelOptsCategory
+  deriving (Show, Read, Eq, Ord)
+
+
+createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
+createChannelOptsToJSON name perms opts = objectFromMaybes optsJSON
+  where
+  optsJSON = case opts of
+    CreateGuildChannelOptsText{..} ->
+                          ["name" .== String name
+                          ,"type" .== Number 0
+                          ,"permission_overwrites" .== perms
+                          ,"topic" .=? createGuildChannelOptsTopic
+                          ,"rate_limit_per_user" .=? createGuildChannelOptsUserMessageRateDelay
+                          ,"nsfw" .=? createGuildChannelOptsIsNSFW
+                          ,"parent_id" .=? createGuildChannelOptsCategoryId]
+    CreateGuildChannelOptsVoice{..} ->
+                          ["name" .== String name
+                          ,"type" .== Number 2
+                          ,"permission_overwrites" .== perms
+                          ,"bitrate" .=? createGuildChannelOptsBitrate
+                          ,"user_limit" .=? createGuildChannelOptsMaxUsers
+                          ,"parent_id" .=? createGuildChannelOptsCategoryId]
+    CreateGuildChannelOptsCategory ->
+                          ["name" .== String name
+                          ,"type" .== Number 4
+                          ,"permission_overwrites" .== perms]
+
+
+
+
+
+data ModifyGuildOpts = ModifyGuildOpts
+  { modifyGuildOptsName         :: Maybe T.Text
+  , modifyGuildOptsAFKChannelId :: Maybe ChannelId
+  , modifyGuildOptsIcon         :: Maybe T.Text
+  , modifyGuildOptsOwnerId      :: Maybe UserId
+   
+   
+   
+   
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ModifyGuildOpts where
+  toJSON ModifyGuildOpts{..} = objectFromMaybes
+                                  ["name" .=? modifyGuildOptsName,
+                                   "afk_channel_id" .=? modifyGuildOptsAFKChannelId,
+                                   "icon" .=? modifyGuildOptsIcon,
+                                   "owner_id" .=? modifyGuildOptsOwnerId]
+
+data GuildMembersTiming = GuildMembersTiming
+                          { guildMembersTimingLimit :: Maybe Int
+                          , guildMembersTimingAfter :: Maybe UserId
+                          } deriving (Show, Read, Eq, Ord)
+
+guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https
+guildMembersTimingToQuery (GuildMembersTiming mLimit mAfter) =
+  let limit = case mLimit of
+              Nothing -> mempty
+              Just lim -> "limit" R.=: lim
+      after = case mAfter of
+              Nothing -> mempty
+              Just aft -> "after" R.=: show aft
+  in limit <> after
+
+guildMajorRoute :: GuildRequest a -> String
+guildMajorRoute c = case c of
+  (GetGuild g) ->                         "guild " <> show g
+  (ModifyGuild g _) ->                    "guild " <> show g
+  (DeleteGuild g) ->                      "guild " <> show g
+  (GetGuildChannels g) ->            "guild_chan " <> show g
+  (CreateGuildChannel g _ _ _) ->    "guild_chan " <> show g
+  (ModifyGuildChannelPositions g _) -> "guild_chan " <> show g
+  (GetGuildMember g _) ->            "guild_memb " <> show g
+  (ListGuildMembers g _) ->         "guild_membs " <> show g
+  (AddGuildMember g _ _) ->         "guild_membs " <> show g
+  (ModifyGuildMember g _ _) ->      "guild_membs " <> show g
+  (ModifyCurrentUserNick g _) ->    "guild_membs " <> show g
+  (AddGuildMemberRole g _ _) ->     "guild_membs " <> show g
+  (RemoveGuildMemberRole g _ _) ->  "guild_membs " <> show g
+  (RemoveGuildMember g _) ->        "guild_membs " <> show g
+  (GetGuildBan g _) ->               "guild_bans " <> show g
+  (GetGuildBans g) ->                "guild_bans " <> show g
+  (CreateGuildBan g _ _) ->           "guild_ban " <> show g
+  (RemoveGuildBan g _) ->             "guild_ban " <> show g
+  (GetGuildRoles g) ->              "guild_roles " <> show g
+  (CreateGuildRole g _) ->          "guild_roles " <> show g
+  (ModifyGuildRolePositions g _) -> "guild_roles " <> show g
+  (ModifyGuildRole g _ _) ->         "guild_role " <> show g
+  (DeleteGuildRole g _) ->           "guild_role " <> show g
+  (GetGuildPruneCount g _) ->       "guild_prune " <> show g
+  (BeginGuildPrune g _) ->          "guild_prune " <> show g
+  (GetGuildVoiceRegions g) ->       "guild_voice " <> show g
+  (GetGuildInvites g) ->            "guild_invit " <> show g
+  (GetGuildIntegrations g) ->       "guild_integ " <> show g
+  (CreateGuildIntegration g _ _) -> "guild_integ " <> show g
+  (ModifyGuildIntegration g _ _) -> "guild_intgr " <> show g
+  (DeleteGuildIntegration g _) ->   "guild_intgr " <> show g
+  (SyncGuildIntegration g _) ->      "guild_sync " <> show g
+  (GetGuildWidget g) ->            "guild_widget " <> show g
+  (ModifyGuildWidget g _) ->       "guild_widget " <> show g
+  (GetGuildVanityURL g) ->                "guild " <> show g
+
+
+guilds :: R.Url 'R.Https
+guilds = baseUrl /: "guilds"
+
+guildJsonRequest :: GuildRequest r -> JsonRequest
+guildJsonRequest c = case c of
+  (GetGuild guild) ->
+      Get (guilds /~ guild) mempty
+
+  (ModifyGuild guild patch) ->
+      Patch (guilds /~ guild) (pure (R.ReqBodyJson patch)) mempty
+
+  (DeleteGuild guild) ->
+      Delete (guilds /~ guild) mempty
+
+  (GetGuildChannels guild) ->
+      Get (guilds /~ guild /: "channels") mempty
+
+  (CreateGuildChannel guild name perms patch) ->
+      Post (guilds /~ guild /: "channels")
+           (pure (R.ReqBodyJson (createChannelOptsToJSON name perms patch))) mempty
+
+  (ModifyGuildChannelPositions guild newlocs) ->
+      let patch = map (\(a, b) -> object [("id", toJSON a)
+                                         ,("position", toJSON b)]) newlocs
+      in Patch (guilds /~ guild /: "channels") (pure (R.ReqBodyJson patch)) mempty
+
+  (GetGuildMember guild member) ->
+      Get (guilds /~ guild /: "members" /~ member) mempty
+
+  (ListGuildMembers guild range) ->
+      Get (guilds /~ guild /: "members") (guildMembersTimingToQuery range)
+
+  (AddGuildMember guild user patch) ->
+      Put (guilds /~ guild /: "members" /~ user) (R.ReqBodyJson patch) mempty
+
+  (ModifyGuildMember guild member patch) ->
+      Patch (guilds /~ guild /: "members" /~ member) (pure (R.ReqBodyJson patch)) mempty
+
+  (ModifyCurrentUserNick guild name) ->
+      let patch = object ["nick" .= name]
+      in Patch (guilds /~ guild /: "members/@me/nick") (pure (R.ReqBodyJson patch)) mempty
+
+  (AddGuildMemberRole guild user role) ->
+      let body = R.ReqBodyJson (object [])
+      in Put (guilds /~ guild /: "members" /~ user /: "roles" /~ role) body mempty
+
+  (RemoveGuildMemberRole guild user role) ->
+      Delete (guilds /~ guild /: "members" /~ user /: "roles" /~ role) mempty
+
+  (RemoveGuildMember guild user) ->
+      Delete (guilds /~ guild /: "members" /~ user) mempty
+
+  (GetGuildBan guild user) -> Get (guilds /~ guild /: "bans" /~ user) mempty
+
+  (GetGuildBans guild) -> Get (guilds /~ guild /: "bans") mempty
+
+  (CreateGuildBan guild user patch) ->
+      Put (guilds /~ guild /: "bans" /~ user) (R.ReqBodyJson patch) mempty
+
+  (RemoveGuildBan guild ban) ->
+      Delete (guilds /~ guild /: "bans" /~ ban) mempty
+
+  (GetGuildRoles guild) ->
+      Get (guilds /~ guild /: "roles") mempty
+
+  (CreateGuildRole guild patch) ->
+      Post (guilds /~ guild /: "roles") (pure (R.ReqBodyJson patch)) mempty
+
+  (ModifyGuildRolePositions guild patch) ->
+      let body = map (\(role, pos) -> object ["id".=role, "position".=pos]) patch
+      in Patch (guilds /~ guild /: "roles") (pure (R.ReqBodyJson body)) mempty
+
+  (ModifyGuildRole guild role patch) ->
+      Patch (guilds /~ guild /: "roles" /~ role) (pure (R.ReqBodyJson patch)) mempty
+
+  (DeleteGuildRole guild role) ->
+      Delete (guilds /~ guild /: "roles" /~ role) mempty
+
+  (GetGuildPruneCount guild days) ->
+      Get (guilds /~ guild /: "prune") ("days" R.=: days)
+
+  (BeginGuildPrune guild days) ->
+      Post (guilds /~ guild /: "prune") (pure R.NoReqBody) ("days" R.=: days)
+
+  (GetGuildVoiceRegions guild) ->
+      Get (guilds /~ guild /: "regions") mempty
+
+  (GetGuildInvites guild) ->
+      Get (guilds /~ guild /: "invites") mempty
+
+  (GetGuildIntegrations guild) ->
+      Get (guilds /~ guild /: "integrations") mempty
+
+  (CreateGuildIntegration guild iid opts) ->
+      let patch = object ["type" .= createGuildIntegrationOptsType opts, "id" .= iid]
+      in Post (guilds /~ guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty
+
+  (ModifyGuildIntegration guild iid patch) ->
+      let body = pure (R.ReqBodyJson patch)
+      in Patch (guilds /~ guild /: "integrations" /~ iid) body mempty
+
+  (DeleteGuildIntegration guild integ) ->
+      Delete (guilds /~ guild /: "integrations" /~ integ) mempty
+
+  (SyncGuildIntegration guild integ) ->
+      Post (guilds /~ guild /: "integrations" /~ integ) (pure R.NoReqBody) mempty
+
+  (GetGuildWidget guild) ->
+      Get (guilds /~ guild /: "integrations") mempty
+
+  (ModifyGuildWidget guild patch) ->
+      Patch (guilds /~ guild /: "widget") (pure (R.ReqBodyJson patch)) mempty
+
+  (GetGuildVanityURL guild) ->
+      Get (guilds /~ guild /: "vanity-url") mempty
+

+ src/Sigmacord/Internal/Rest/HTTP.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE MultiWayIf #-}
+
+
+module Sigmacord.Internal.Rest.HTTP
+  ( restLoop
+  , Request(..)
+  , JsonRequest(..)
+  , RestCallInternalException(..)
+  ) where
+
+import Prelude hiding (log)
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent (threadDelay)
+import Control.Exception.Safe (try)
+import Control.Concurrent.MVar
+import Control.Concurrent.Chan
+import Data.Ix (inRange)
+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Text.Read (readMaybe)
+import Data.Maybe (fromMaybe)
+import qualified Network.HTTP.Req as R
+import qualified Data.Map.Strict as M
+
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Rest.Prelude
+
+
+data RestCallInternalException
+  
+  = RestCallInternalErrorCode Int B.ByteString B.ByteString
+  
+  | RestCallInternalNoParse String BL.ByteString
+  
+  | RestCallInternalHttpException R.HttpException
+  deriving (Show)
+
+
+restLoop :: Auth -> Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString))
+                 -> Chan T.Text -> IO ()
+restLoop auth urls log = loop M.empty
+  where
+  loop ratelocker = do
+    threadDelay (40 * 1000)
+    (route, request, thread) <- readChan urls
+    curtime <- getPOSIXTime
+    case compareRate ratelocker route curtime of
+      Locked -> do writeChan urls (route, request, thread)
+                   loop ratelocker
+      Available -> do let action = compileRequest auth request
+                      reqIO <- try $ restIOtoIO (tryRequest log action)
+                      case reqIO :: Either R.HttpException (RequestResponse, Timeout) of
+                        Left e -> do
+                          writeChan log ("rest - http exception " <> T.pack (show e))
+                          putMVar thread (Left (RestCallInternalHttpException e))
+                          loop ratelocker
+                        Right (resp, retry) -> do
+                          case resp of
+                            
+                            ResponseByteString "" -> putMVar thread (Right "[]")
+                            ResponseByteString bs -> putMVar thread (Right bs)
+                            ResponseErrorCode e s b ->
+                              putMVar thread (Left (RestCallInternalErrorCode e s b))
+                            ResponseTryAgain -> writeChan urls (route, request, thread)
+                          case retry of
+                            GlobalWait i -> do
+                                writeChan log ("rest - GLOBAL WAIT LIMIT: "
+                                                    <> T.pack (show ((i - curtime) * 1000)))
+                                threadDelay $ round ((i - curtime + 0.1) * 1000)
+                                loop ratelocker
+                            PathWait i -> loop $ M.insert route i (removeAllExpire ratelocker curtime)
+                            NoLimit -> loop ratelocker
+
+data RateLimited = Available | Locked
+
+compareRate :: M.Map String POSIXTime -> String -> POSIXTime -> RateLimited
+compareRate ratelocker route curtime =
+    case M.lookup route ratelocker of
+      Just unlockTime -> if curtime < unlockTime then Locked else Available
+      Nothing -> Available
+
+removeAllExpire :: M.Map String POSIXTime -> POSIXTime -> M.Map String POSIXTime
+removeAllExpire ratelocker curtime =
+  if M.size ratelocker > 100 then M.filter (> curtime) ratelocker
+                             else ratelocker
+
+data RequestResponse = ResponseTryAgain
+                     | ResponseByteString BL.ByteString
+                     | ResponseErrorCode Int B.ByteString B.ByteString
+    deriving (Show)
+
+data Timeout = GlobalWait POSIXTime
+             | PathWait POSIXTime
+             | NoLimit
+
+tryRequest :: Chan T.Text -> RestIO R.LbsResponse -> RestIO (RequestResponse, Timeout)
+tryRequest _log action = do
+  resp <- action
+  now <- liftIO getPOSIXTime
+  let body   = R.responseBody resp
+      code   = R.responseStatusCode resp
+      status = R.responseStatusMessage resp
+      global = (Just ("true" :: String) ==) $ readMaybeBS =<< R.responseHeader resp "X-RateLimit-Global"
+      remain = fromMaybe 1 $ readMaybeBS =<< R.responseHeader resp "X-RateLimit-Remaining" :: Integer
+      reset = withDelta . fromMaybe 10 $ readMaybeBS =<< R.responseHeader resp "X-RateLimit-Reset-After"
+
+      withDelta :: Double -> POSIXTime
+      withDelta dt = now + fromRational (toRational dt)
+
+  if | code == 429 -> pure (ResponseTryAgain, if global then GlobalWait reset
+                                                        else PathWait reset)
+     | code `elem` [500,502] -> pure (ResponseTryAgain, NoLimit)
+     | inRange (200,299) code -> pure ( ResponseByteString body
+                                      , if remain > 0 then NoLimit else PathWait reset )
+     | inRange (400,499) code -> pure (ResponseErrorCode code status (BL.toStrict body)
+                                      , if remain > 0 then NoLimit else PathWait reset )
+     | otherwise -> pure (ResponseErrorCode code status (BL.toStrict body), NoLimit)
+
+readMaybeBS :: Read a => B.ByteString -> Maybe a
+readMaybeBS = readMaybe . T.unpack . TE.decodeUtf8
+
+compileRequest :: Auth -> JsonRequest -> RestIO R.LbsResponse
+compileRequest auth request = action
+  where
+  authopt = authHeader auth <> R.header "X-RateLimit-Precision" "millisecond"
+
+  action = case request of
+    (Delete url      opts) -> R.req R.DELETE url R.NoReqBody R.lbsResponse (authopt <> opts)
+    (Get    url      opts) -> R.req R.GET    url R.NoReqBody R.lbsResponse (authopt <> opts)
+    (Put    url body opts) -> R.req R.PUT    url body        R.lbsResponse (authopt <> opts)
+    (Patch  url body opts) -> do b <- body
+                                 R.req R.PATCH  url b        R.lbsResponse (authopt <> opts)
+    (Post   url body opts) -> do b <- body
+                                 R.req R.POST   url b        R.lbsResponse (authopt <> opts)

+ src/Sigmacord/Internal/Rest/Interactions.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Sigmacord.Internal.Rest.Interactions (InteractionResponseRequest(..)) where
+
+import Data.Aeson (encode)
+import qualified Data.ByteString.Lazy as BL
+import Sigmacord.Internal.Rest.Prelude
+    ( RestIO,
+      Request(..),
+      JsonRequest(Delete, Post, Get, Patch),
+      baseUrl)
+import Sigmacord.Internal.Types
+import Sigmacord.Internal.Types.Interactions
+import Network.HTTP.Client.MultipartFormData (PartM, partBS)
+import Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+
+
+data InteractionResponseRequest a where
+  
+  
+  
+  
+  
+  CreateInteractionResponse :: InteractionId -> InteractionToken -> InteractionResponse -> InteractionResponseRequest ()
+  
+  GetOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest Message
+  
+  EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message
+  
+  DeleteOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest ()
+  
+  CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message
+  
+  GetFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest Message
+  
+  EditFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponse -> InteractionResponseRequest Message
+  
+  DeleteFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest ()
+
+instance Request (InteractionResponseRequest a) where
+  jsonRequest = interactionResponseJsonRequest
+  majorRoute = interactionResponseMajorRoute
+
+interactionResponseMajorRoute :: InteractionResponseRequest a -> String
+interactionResponseMajorRoute a = case a of
+  (CreateInteractionResponse iid _ _) -> "intresp " <> show iid
+  (GetOriginalInteractionResponse aid _) -> "intresp " <> show aid
+  (EditOriginalInteractionResponse aid _ _) -> "intresp " <> show aid
+  (DeleteOriginalInteractionResponse aid _) -> "intresp " <> show aid
+  (CreateFollowupInteractionMessage iid _ _) -> "intrespf " <> show iid
+  (GetFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid
+  (EditFollowupInteractionMessage aid _ _ _) -> "intrespf " <> show aid
+  (DeleteFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid
+
+interaction :: ApplicationId -> InteractionToken -> R.Url 'R.Https
+interaction aid it = baseUrl /: "webhooks" /~ aid /~ it /: "messages"
+
+interactionResponseJsonRequest :: InteractionResponseRequest a -> JsonRequest
+interactionResponseJsonRequest a = case a of
+  (CreateInteractionResponse iid it i) ->
+    Post (baseUrl /: "interactions" /~ iid /~ it /: "callback") (convert i) mempty
+  (GetOriginalInteractionResponse aid it) ->
+    Get (interaction aid it /: "@original") mempty
+  (EditOriginalInteractionResponse aid it i) ->
+    Patch (interaction aid it /: "@original") (convertIRM i) mempty
+  (DeleteOriginalInteractionResponse aid it) ->
+    Delete (interaction aid it /: "@original") mempty
+  (CreateFollowupInteractionMessage aid it i) ->
+    Post (baseUrl /: "webhooks" /~ aid /~ it) (convertIRM i) mempty
+  (GetFollowupInteractionMessage aid it mid) ->
+    Get (interaction aid it /~ mid) mempty
+  (EditFollowupInteractionMessage aid it mid i) ->
+    Patch (interaction aid it /~ mid) (convert i) mempty
+  (DeleteFollowupInteractionMessage aid it mid) ->
+    Delete (interaction aid it /~ mid) mempty
+  where
+    convert :: InteractionResponse -> RestIO R.ReqBodyMultipart
+    convert ir@(InteractionResponseChannelMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)
+    convert ir@(InteractionResponseUpdateMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)
+    convert ir = R.reqBodyMultipart [partBS "payload_json" $ BL.toStrict $ encode ir]
+    convertIRM :: InteractionResponseMessage -> RestIO R.ReqBodyMultipart
+    convertIRM irm = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode irm) : convert' irm)
+    convert' :: InteractionResponseMessage -> [PartM IO]
+    convert' InteractionResponseMessage {..} = case interactionResponseMessageEmbeds of
+      Nothing -> []
+      Just f -> (maybeEmbed . Just) =<< f

+ src/Sigmacord/Internal/Rest/Invite.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.Invite
+  ( InviteRequest(..)
+  ) where
+
+import Network.HTTP.Req ((/:))
+import qualified Network.HTTP.Req as R
+import qualified Data.Text as T
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+
+instance Request (InviteRequest a) where
+  majorRoute = inviteMajorRoute
+  jsonRequest = inviteJsonRequest
+
+
+
+data InviteRequest a where
+  
+  GetInvite :: T.Text -> InviteRequest Invite
+  
+  DeleteInvite :: T.Text -> InviteRequest Invite
+
+inviteMajorRoute :: InviteRequest a -> String
+inviteMajorRoute c = case c of
+  (GetInvite _) ->     "invite "
+  (DeleteInvite _) ->  "invite "
+
+invite :: R.Url 'R.Https
+invite = baseUrl /: "invites"
+
+inviteJsonRequest :: InviteRequest r -> JsonRequest
+inviteJsonRequest c = case c of
+  (GetInvite g) -> Get (invite R./: g) mempty
+  (DeleteInvite g) -> Delete (invite R./: g) mempty

+ src/Sigmacord/Internal/Rest/Prelude.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+
+module Sigmacord.Internal.Rest.Prelude where
+
+import Prelude hiding (log)
+import Control.Exception.Safe (throwIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.String (IsString(fromString))
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+
+import qualified Network.HTTP.Req as R
+import Web.Internal.HttpApiData (ToHttpApiData)
+
+import Sigmacord.Internal.Types
+
+import Paths_Sigmacord_haskell (version)
+import Data.Version (showVersion)
+
+
+apiVersion :: T.Text
+apiVersion = "10"
+
+
+baseUrl :: R.Url 'R.Https
+baseUrl = R.https "Sigmacord.com" R./: "api" R./: apiVersion'
+  where apiVersion' = "v" <> apiVersion
+
+
+authHeader :: Auth -> R.Option 'R.Https
+authHeader auth =
+          R.header "Authorization" (TE.encodeUtf8 (authToken auth))
+       <> R.header "User-Agent" agent
+  where
+  
+  
+  agent = fromString $ "SigmacordBot (https://github.com/Sigmacord-haskell/Sigmacord-haskell, " <> showVersion version <> ")"
+
+
+infixl 5 /?
+(/?) :: ToHttpApiData a => R.Url scheme -> Maybe a -> R.Url scheme
+(/?) url Nothing = url
+(/?) url (Just part) = url R./~ part
+
+
+
+data JsonRequest where
+  Delete ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest
+  Get    ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest
+  Put    :: R.HttpBody a => R.Url 'R.Https -> a -> R.Option 'R.Https -> JsonRequest
+  Patch  :: R.HttpBody a => R.Url 'R.Https -> RestIO a -> R.Option 'R.Https -> JsonRequest
+  Post   :: R.HttpBody a => R.Url 'R.Https -> RestIO a -> R.Option 'R.Https -> JsonRequest
+
+class Request a where
+  
+  
+  majorRoute :: a -> String
+
+  
+  jsonRequest :: a -> JsonRequest
+
+
+newtype RestIO a = RestIO { restIOtoIO :: IO a }
+  deriving (Functor, Applicative, Monad, MonadIO)
+
+instance R.MonadHttp RestIO where
+  
+  handleHttpException = liftIO . throwIO
+  
+  getHttpConfig = pure $ R.defaultHttpConfig { R.httpConfigCheckResponse = \_ _ _ -> Nothing }

+ src/Sigmacord/Internal/Rest/ScheduledEvents.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.ScheduledEvents
+    ( ScheduledEventRequest(..)
+    ) where
+import           Data.Aeson                     ( ToJSON(toJSON) )
+import           Sigmacord.Internal.Rest.Prelude  ( JsonRequest(..)
+                                                , Request
+                                                    ( jsonRequest
+                                                    , majorRoute
+                                                    )
+                                                , baseUrl
+                                                )
+import           Sigmacord.Internal.Types.Prelude ( GuildId
+                                                , ScheduledEventId
+                                                )
+import           Sigmacord.Internal.Types.ScheduledEvents
+                                                ( CreateScheduledEventData
+                                                , ModifyScheduledEventData
+                                                , ScheduledEvent
+                                                , ScheduledEventUser
+                                                )
+import qualified Network.HTTP.Req              as R
+import           Network.HTTP.Req               ( (/:), (/~) )
+
+
+
+data ScheduledEventRequest a where
+  
+  ListScheduledEvents    ::GuildId
+                         -> ScheduledEventRequest [ScheduledEvent]
+  
+  CreateScheduledEvent   ::GuildId
+                         -> CreateScheduledEventData
+                         -> ScheduledEventRequest ScheduledEvent
+  
+  GetScheduledEvent      ::GuildId
+                         -> ScheduledEventId
+                         -> ScheduledEventRequest ScheduledEvent
+  
+  ModifyScheduledEvent   ::GuildId
+                         -> ScheduledEventId
+                         -> ModifyScheduledEventData
+                         -> ScheduledEventRequest ScheduledEvent
+  
+  DeleteScheduledEvent   ::GuildId
+                         -> ScheduledEventId
+                         -> ScheduledEventRequest ()
+  
+  GetScheduledEventUsers ::GuildId
+                         -> ScheduledEventId
+                         -> ScheduledEventRequest [ScheduledEventUser]
+
+sevEndpoint :: GuildId -> R.Url 'R.Https
+sevEndpoint gid = baseUrl /: "guilds" /~ gid /: "scheduled-events"
+
+instance Request (ScheduledEventRequest a) where
+    majorRoute = const "scheduledEvent"
+    jsonRequest rq = case rq of
+        ListScheduledEvents gid  -> Get (sevEndpoint gid) mempty
+        GetScheduledEvent gid ev -> Get (sevEndpoint gid /~ ev) mempty
+        CreateScheduledEvent gid ev ->
+            Post (sevEndpoint gid) (pure $ R.ReqBodyJson $ toJSON ev) mempty
+        ModifyScheduledEvent gid evi ev -> Patch
+            (sevEndpoint gid /~ evi)
+            (pure $ R.ReqBodyJson $ toJSON ev)
+            mempty
+        DeleteScheduledEvent gid evi -> Delete (sevEndpoint gid /~ evi) mempty
+        GetScheduledEventUsers gid evi ->
+            Get (sevEndpoint gid /~ evi /: "users") mempty

+ src/Sigmacord/Internal/Rest/User.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.User
+  ( UserRequest(..)
+  , parseAvatarImage
+  ) where
+
+
+import Data.Aeson
+import Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64 as B64
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+
+instance Request (UserRequest a) where
+  majorRoute = userMajorRoute
+  jsonRequest = userJsonRequest
+
+
+
+data UserRequest a where
+  
+  
+  
+  GetCurrentUser       :: UserRequest User
+  
+  GetUser              :: UserId -> UserRequest User
+  
+  ModifyCurrentUser    :: T.Text -> Base64Image User -> UserRequest User
+  
+  
+  GetCurrentUserGuilds :: UserRequest [PartialGuild]
+  
+  LeaveGuild           :: GuildId -> UserRequest ()
+  
+  GetUserDMs           :: UserRequest [Channel]
+  
+  CreateDM             :: UserId -> UserRequest Channel
+
+  GetUserConnections   :: UserRequest [ConnectionObject]
+
+
+
+
+
+
+
+
+parseAvatarImage :: B.ByteString -> Either T.Text (Base64Image User)
+parseAvatarImage bs
+  | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs)))
+  | otherwise                   = Left "Unsupported image format provided"
+
+userMajorRoute :: UserRequest a -> String
+userMajorRoute c = case c of
+  (GetCurrentUser) ->                        "me "
+  (GetUser _) ->                           "user "
+  (ModifyCurrentUser _ _) ->        "modify_user "
+  (GetCurrentUserGuilds) ->     "get_user_guilds "
+  (LeaveGuild g) ->                 "leave_guild " <> show g
+  (GetUserDMs) ->                       "get_dms "
+  (CreateDM _) ->                       "make_dm "
+  (GetUserConnections) ->           "connections "
+
+users :: R.Url 'R.Https
+users = baseUrl /: "users"
+
+userJsonRequest :: UserRequest r -> JsonRequest
+userJsonRequest c = case c of
+  (GetCurrentUser) -> Get (users /: "@me") mempty
+
+  (GetUser user) -> Get (users /~ user ) mempty
+
+  (ModifyCurrentUser name b64im) ->
+      Patch (users /: "@me")  (pure (R.ReqBodyJson (object [ "username" .= name
+                                                           , "avatar" .= b64im ]))) mempty
+
+  (GetCurrentUserGuilds) -> Get (users /: "@me" /: "guilds") mempty
+
+  (LeaveGuild guild) -> Delete (users /: "@me" /: "guilds" /~ guild) mempty
+
+  (GetUserDMs) -> Get (users /: "@me" /: "channels") mempty
+
+  (CreateDM user) ->
+      let body = R.ReqBodyJson $ object ["recipient_id" .= user]
+      in Post (users /: "@me" /: "channels") (pure body) mempty
+
+  (GetUserConnections) ->
+    Get (users /: "@me" /: "connections") mempty

+ src/Sigmacord/Internal/Rest/Voice.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.Voice
+  ( VoiceRequest(..)
+  ) where
+
+
+import Network.HTTP.Req ((/:))
+import qualified Network.HTTP.Req as R
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+
+instance Request (VoiceRequest a) where
+  majorRoute = voiceMajorRoute
+  jsonRequest = voiceJsonRequest
+
+
+data VoiceRequest a where
+  
+  ListVoiceRegions :: VoiceRequest [VoiceRegion]
+
+voiceMajorRoute :: VoiceRequest a -> String
+voiceMajorRoute c = case c of
+  (ListVoiceRegions) -> "whatever "
+
+voices :: R.Url 'R.Https
+voices = baseUrl /: "voice"
+
+voiceJsonRequest :: VoiceRequest r -> JsonRequest
+voiceJsonRequest c = case c of
+  (ListVoiceRegions) -> Get (voices /: "regions") mempty

+ src/Sigmacord/Internal/Rest/Webhook.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Rest.Webhook
+  ( CreateWebhookOpts(..)
+  , ExecuteWebhookWithTokenOpts(..)
+  , ModifyWebhookOpts(..)
+  , WebhookContent(..)
+  , WebhookRequest(..)
+  ) where
+
+import           Data.Aeson
+import qualified Data.Text as T
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import           Network.HTTP.Req ((/:), (/~))
+import qualified Network.HTTP.Req as R
+import Network.HTTP.Client (RequestBody (RequestBodyBS))
+import Network.HTTP.Client.MultipartFormData (partBS, partFileRequestBody)
+
+import Sigmacord.Internal.Rest.Prelude
+import Sigmacord.Internal.Types
+
+instance Request (WebhookRequest a) where
+  majorRoute = webhookMajorRoute
+  jsonRequest = webhookJsonRequest
+
+
+data WebhookRequest a where
+  
+  
+  
+  
+  
+  
+  CreateWebhook :: ChannelId
+                -> CreateWebhookOpts
+                -> WebhookRequest Webhook
+  
+  GetChannelWebhooks :: ChannelId
+                     -> WebhookRequest [Webhook]
+  
+  GetGuildWebhooks :: GuildId
+                   -> WebhookRequest [Webhook]
+  
+  GetWebhook :: WebhookId
+             -> Maybe WebhookToken
+             -> WebhookRequest Webhook
+  
+  
+  ModifyWebhook :: WebhookId
+                -> Maybe WebhookToken
+                -> ModifyWebhookOpts
+                -> WebhookRequest Webhook
+  
+  
+  DeleteWebhook :: WebhookId
+                -> Maybe WebhookToken
+                -> WebhookRequest ()
+  
+  
+  
+  
+  ExecuteWebhook :: WebhookId
+                 -> WebhookToken
+                 -> ExecuteWebhookWithTokenOpts
+                 -> WebhookRequest ()
+  
+  
+
+  
+  GetWebhookMessage :: WebhookId
+                    -> WebhookToken
+                    -> MessageId
+                    -> WebhookRequest Message
+  
+  EditWebhookMessage :: WebhookId
+                     -> WebhookToken
+                     -> MessageId
+                     -> T.Text 
+                     -> WebhookRequest Message
+  
+  DeleteWebhookMessage :: WebhookId
+                       -> WebhookToken
+                       -> MessageId
+                       -> WebhookRequest ()
+
+
+data ModifyWebhookOpts = ModifyWebhookOpts
+  { modifyWebhookOptsName          :: Maybe T.Text
+  , modifyWebhookOptsAvatar        :: Maybe T.Text
+  , modifyWebhookOptsChannelId     :: Maybe ChannelId
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ModifyWebhookOpts where
+  toJSON ModifyWebhookOpts{..} = objectFromMaybes
+                         ["channel_id" .=? modifyWebhookOptsChannelId,
+                          "name" .=? modifyWebhookOptsName,
+                          "avatar" .=? modifyWebhookOptsAvatar ]
+
+
+data CreateWebhookOpts = CreateWebhookOpts
+  { createWebhookOptsName          :: T.Text
+  , createWebhookOptsAvatar        :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON CreateWebhookOpts where
+  toJSON CreateWebhookOpts{..} = objectFromMaybes
+                         ["name" .== createWebhookOptsName,
+                          "avatar" .=? createWebhookOptsAvatar ]
+
+
+data ExecuteWebhookWithTokenOpts = ExecuteWebhookWithTokenOpts
+  { executeWebhookWithTokenOptsUsername      :: Maybe T.Text
+  , executeWebhookWithTokenOptsContent       :: WebhookContent
+  } deriving (Show, Read, Eq, Ord)
+
+
+data WebhookContent = WebhookContentText T.Text
+                    | WebhookContentFile T.Text B.ByteString
+                    | WebhookContentEmbeds [CreateEmbed]
+  deriving (Show, Read, Eq, Ord)
+
+webhookContentJson :: WebhookContent -> [(AesonKey, Value)]
+webhookContentJson c = case c of
+                      WebhookContentText t -> [("content", toJSON t)]
+                      WebhookContentFile _ _  -> []
+                      WebhookContentEmbeds e -> [("embeds", toJSON (createEmbed <$> e))]
+
+instance ToJSON ExecuteWebhookWithTokenOpts where
+  toJSON ExecuteWebhookWithTokenOpts{..} = objectFromMaybes $
+                          ["username" .=? executeWebhookWithTokenOptsUsername]
+                           <> fmap Just (webhookContentJson executeWebhookWithTokenOptsContent)
+
+
+webhookMajorRoute :: WebhookRequest a -> String
+webhookMajorRoute ch = case ch of
+  (CreateWebhook c _) ->    "aaaaaahook " <> show c
+  (GetChannelWebhooks c) -> "aaaaaahook " <> show c
+  (GetGuildWebhooks g) ->   "aaaaaahook " <> show g
+  (GetWebhook w _) ->       "getwebhook " <> show w
+  (ModifyWebhook w _ _) ->  "modifyhook " <> show w
+  (DeleteWebhook w _) ->    "deletehook " <> show w
+  (ExecuteWebhook w _ _) ->  "executehk " <> show w
+  (GetWebhookMessage w _ _) -> "gethkmsg " <> show w
+  (EditWebhookMessage w _ _ _) -> "edithkmsg " <> show w
+  (DeleteWebhookMessage w _ _) -> "delhkmsg " <> show w
+
+
+webhookJsonRequest :: WebhookRequest r -> JsonRequest
+webhookJsonRequest ch = case ch of
+  (CreateWebhook channel patch) ->
+    let body = pure (R.ReqBodyJson patch)
+    in Post (baseUrl /: "channels" /~ channel /: "webhooks") body  mempty
+
+  (GetChannelWebhooks c) ->
+    Get (baseUrl /: "channels" /~ c /: "webhooks")  mempty
+
+  (GetGuildWebhooks g) ->
+    Get (baseUrl /: "guilds" /~ g /: "webhooks")  mempty
+
+  (GetWebhook w t) ->
+    Get (baseUrl /: "webhooks" /~ w /? t)  mempty
+
+  (ModifyWebhook w t p) ->
+    Patch (baseUrl /: "webhooks" /~ w /? t) (pure (R.ReqBodyJson p))  mempty
+
+  (DeleteWebhook w t) ->
+    Delete (baseUrl /: "webhooks" /~ w /? t)  mempty
+
+  (ExecuteWebhook w tok o) ->
+    case executeWebhookWithTokenOptsContent o of
+      WebhookContentFile name text  ->
+        let part = partFileRequestBody "file" (T.unpack name) (RequestBodyBS text)
+            body = R.reqBodyMultipart [part]
+        in Post (baseUrl /: "webhooks" /~ w /~ tok) body mempty
+      WebhookContentText _ ->
+        let body = pure (R.ReqBodyJson o)
+        in Post (baseUrl /: "webhooks" /~ w /~ tok) body mempty
+      WebhookContentEmbeds embeds ->
+        let mkPart (name,content) = partFileRequestBody name (T.unpack name) (RequestBodyBS content)
+            uploads CreateEmbed{..} = [(n,c) | (n, Just (CreateEmbedImageUpload c)) <-
+                                          [ ("author.png", createEmbedAuthorIcon)
+                                          , ("thumbnail.png", createEmbedThumbnail)
+                                          , ("image.png", createEmbedImage)
+                                          , ("footer.png", createEmbedFooterIcon) ]]
+            parts =  map mkPart (concatMap uploads embeds)
+            partsJson = [partBS "payload_json" $ BL.toStrict $ encode $ toJSON $ object ["embed" .= createEmbed e] | e <- embeds]
+            body = R.reqBodyMultipart (partsJson ++ parts)
+        in Post (baseUrl /: "webhooks" /~ w /: unToken tok) body mempty
+
+  (GetWebhookMessage w t m) ->
+    Get (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m)  mempty
+
+  (EditWebhookMessage w t m p) ->
+    Patch (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m) (pure (R.ReqBodyJson $ object ["content" .= p]))  mempty
+
+  (DeleteWebhookMessage w t m) ->
+    Delete (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m)  mempty

+ src/Sigmacord/Internal/Types.hs view
@@ -0,0 +1,73 @@+module Sigmacord.Internal.Types
+  ( module Sigmacord.Internal.Types.Prelude,
+    module Sigmacord.Internal.Types.Channel,
+    module Sigmacord.Internal.Types.Color,
+    module Sigmacord.Internal.Types.Events,
+    module Sigmacord.Internal.Types.Gateway,
+    module Sigmacord.Internal.Types.Guild,
+    module Sigmacord.Internal.Types.User,
+    module Sigmacord.Internal.Types.Embed,
+    module Sigmacord.Internal.Types.Components,
+    module Sigmacord.Internal.Types.Emoji,
+    module Sigmacord.Internal.Types.RolePermissions,
+    module Data.Aeson,
+    module Data.Time.Clock,
+    userFacingEvent,
+  )
+where
+
+import Data.Aeson (Object, ToJSON (toJSON))
+import Data.Time.Clock (UTCTime (..))
+import Sigmacord.Internal.Types.Channel
+import Sigmacord.Internal.Types.Color
+import Sigmacord.Internal.Types.Components
+import Sigmacord.Internal.Types.Embed
+import Sigmacord.Internal.Types.Emoji
+import Sigmacord.Internal.Types.Events
+import Sigmacord.Internal.Types.Gateway
+import Sigmacord.Internal.Types.Guild
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.User
+import Sigmacord.Internal.Types.RolePermissions
+
+
+userFacingEvent :: EventInternalParse -> Event
+userFacingEvent event = case event of
+  InternalReady a b c d e f g -> Ready a b c d e f g
+  InternalResumed a -> Resumed a
+  InternalChannelCreate a -> ChannelCreate a
+  InternalChannelUpdate a -> ChannelUpdate a
+  InternalChannelDelete a -> ChannelDelete a
+  InternalThreadCreate a -> ThreadCreate a
+  InternalThreadUpdate a -> ThreadUpdate a
+  InternalThreadDelete a -> ThreadDelete a
+  InternalThreadListSync a -> ThreadListSync a
+  InternalThreadMembersUpdate a -> ThreadMembersUpdate a
+  InternalChannelPinsUpdate a b -> ChannelPinsUpdate a b
+  InternalGuildCreate a b -> GuildCreate a b
+  InternalGuildUpdate a -> GuildUpdate a
+  InternalGuildDelete a -> GuildDelete a
+  InternalGuildBanAdd a b -> GuildBanAdd a b
+  InternalGuildBanRemove a b -> GuildBanRemove a b
+  InternalGuildEmojiUpdate a b -> GuildEmojiUpdate a b
+  InternalGuildIntegrationsUpdate a -> GuildIntegrationsUpdate a
+  InternalGuildMemberAdd a b -> GuildMemberAdd a b
+  InternalGuildMemberRemove a b -> GuildMemberRemove a b
+  InternalGuildMemberUpdate a b c d -> GuildMemberUpdate a b c d
+  InternalGuildMemberChunk a b -> GuildMemberChunk a b
+  InternalGuildRoleCreate a b -> GuildRoleCreate a b
+  InternalGuildRoleUpdate a b -> GuildRoleUpdate a b
+  InternalGuildRoleDelete a b -> GuildRoleDelete a b
+  InternalMessageCreate a -> MessageCreate a
+  InternalMessageUpdate a b -> MessageUpdate a b
+  InternalMessageDelete a b -> MessageDelete a b
+  InternalMessageDeleteBulk a b -> MessageDeleteBulk a b
+  InternalMessageReactionAdd a -> MessageReactionAdd a
+  InternalMessageReactionRemove a -> MessageReactionRemove a
+  InternalMessageReactionRemoveAll a b -> MessageReactionRemoveAll a b
+  InternalMessageReactionRemoveEmoji a -> MessageReactionRemoveEmoji a
+  InternalPresenceUpdate a -> PresenceUpdate a
+  InternalTypingStart a -> TypingStart a
+  InternalUserUpdate a -> UserUpdate a
+  InternalInteractionCreate a -> InteractionCreate a
+  InternalUnknownEvent a b -> UnknownEvent a b

+ src/Sigmacord/Internal/Types/ApplicationCommands.hs view
@@ -0,0 +1,774 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Sigmacord.Internal.Types.ApplicationCommands
+  ( ApplicationCommand (..),
+    Options (..),
+    OptionSubcommandOrGroup (..),
+    OptionSubcommand (..),
+    OptionValue (..),
+    createChatInput,
+    createUser,
+    createMessage,
+    CreateApplicationCommand (..),
+    EditApplicationCommand (..),
+    defaultEditApplicationCommand,
+    Choice (..),
+    ChannelTypeOption (..),
+    GuildApplicationCommandPermissions (..),
+    ApplicationCommandPermissions (..),
+    Number,
+    AutocompleteOrChoice,
+    LocalizedText,
+    Locale
+  )
+where
+
+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Number, Object), object, withArray, withObject, (.!=), (.:), (.:!), (.:?))
+import Data.Aeson.Types (Pair, Parser)
+import Data.Foldable (Foldable (toList))
+import Data.Scientific (Scientific)
+import Data.Char (isLower, isNumber)
+import Sigmacord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, Snowflake, objectFromMaybes, (.==), (.=?))
+import Data.Map.Strict (Map)
+import Sigmacord.Internal.Types.Channel ( ChannelTypeOption(..) )
+
+import qualified Data.Text as T
+
+type Number = Scientific
+
+
+data ApplicationCommand
+  = ApplicationCommandUser
+      { 
+        applicationCommandId :: ApplicationCommandId,
+        
+        applicationCommandApplicationId :: ApplicationId,
+        
+        applicationCommandGuildId :: Maybe GuildId,
+        
+        applicationCommandName :: T.Text,
+        
+        applicationCommandLocalizedName :: Maybe LocalizedText,
+        
+        applicationCommandDefaultMemberPermissions :: Maybe T.Text,
+        
+        applicationCommandDMPermission :: Maybe Bool,
+        
+        applicationCommandVersion :: Snowflake
+      }
+  | ApplicationCommandMessage
+      { 
+        applicationCommandId :: ApplicationCommandId,
+        
+        applicationCommandApplicationId :: ApplicationId,
+        
+        applicationCommandGuildId :: Maybe GuildId,
+        
+        applicationCommandName :: T.Text,
+        
+        applicationCommandLocalizedName :: Maybe LocalizedText,
+        
+        applicationCommandDefaultMemberPermissions :: Maybe T.Text,
+        
+        applicationCommandDMPermission :: Maybe Bool,
+        
+        applicationCommandVersion :: Snowflake
+      }
+  | ApplicationCommandChatInput
+      { 
+        applicationCommandId :: ApplicationCommandId,
+        
+        applicationCommandApplicationId :: ApplicationId,
+        
+        applicationCommandGuildId :: Maybe GuildId,
+        
+        applicationCommandName :: T.Text,
+        
+        applicationCommandLocalizedName :: Maybe LocalizedText,
+        
+        applicationCommandDescription :: T.Text,
+        
+        applicationCommandLocalizedDescription :: Maybe LocalizedText,
+        
+        applicationCommandOptions :: Maybe Options,
+        
+        applicationCommandDefaultMemberPermissions :: Maybe T.Text,
+        
+        applicationCommandDMPermission :: Maybe Bool,
+        
+        applicationCommandVersion :: Snowflake
+      }
+  deriving (Show, Eq, Read)
+
+instance FromJSON ApplicationCommand where
+  parseJSON =
+    withObject
+      "ApplicationCommand"
+      ( \v -> do
+          acid <- v .: "id"
+          aid <- v .: "application_id"
+          gid <- v .:? "guild_id"
+          name <- v .: "name"
+          lname <- v .:? "name_localizations"
+          defPerm <- v .:? "default_member_permissions"
+          dmPerm <- v .:? "dm_permission"
+          version <- v .: "version"
+          t <- v .:? "type" :: Parser (Maybe Int)
+          case t of
+            (Just 2) -> return $ ApplicationCommandUser acid aid gid name lname defPerm dmPerm version
+            (Just 3) -> return $ ApplicationCommandMessage acid aid gid name lname defPerm dmPerm version
+            _ -> do
+              desc <- v .: "description"
+              options <- v .:? "options"
+              ldesc <- v .:? "description_localizations"
+              return $ ApplicationCommandChatInput acid aid gid name lname desc ldesc options defPerm dmPerm version
+      )
+
+
+data Options
+  = OptionsSubcommands [OptionSubcommandOrGroup]
+  | OptionsValues [OptionValue]
+  deriving (Show, Eq, Read)
+
+instance FromJSON Options where
+  parseJSON =
+    withArray
+      "Options"
+      ( \a -> do
+          let a' = toList a
+          case a' of
+            [] -> return $ OptionsValues []
+            (v' : _) ->
+              withObject
+                "Options item"
+                ( \v -> do
+                    t <- v .: "type" :: Parser Int
+                    if t == 1 || t == 2
+                      then OptionsSubcommands <$> mapM parseJSON a'
+                      else OptionsValues <$> mapM parseJSON a'
+                )
+                v'
+      )
+
+instance ToJSON Options where
+  toJSON (OptionsSubcommands o) = toJSON o
+  toJSON (OptionsValues o) = toJSON o
+
+
+data OptionSubcommandOrGroup
+  = OptionSubcommandGroup
+      { 
+        optionSubcommandGroupName :: T.Text,
+        
+        optionSubcommandGroupLocalizedName :: Maybe LocalizedText,
+        
+        optionSubcommandGroupDescription :: T.Text,
+        
+        optionSubcommandGroupLocalizedDescription :: Maybe LocalizedText,
+        
+        optionSubcommandGroupOptions :: [OptionSubcommand]
+      }
+  | OptionSubcommandOrGroupSubcommand OptionSubcommand
+  deriving (Show, Eq, Read)
+
+instance FromJSON OptionSubcommandOrGroup where
+  parseJSON =
+    withObject
+      "OptionSubcommandOrGroup"
+      ( \v -> do
+          t <- v .: "type" :: Parser Int
+          case t of
+            2 ->
+              OptionSubcommandGroup
+                <$> v .: "name"
+                <*> v .:? "name_localizations"
+                <*> v .: "description"
+                <*> v .:? "description_localizations"
+                <*> v .: "options"
+            1 -> OptionSubcommandOrGroupSubcommand <$> parseJSON (Object v)
+            _ -> fail "unexpected subcommand group type"
+      )
+
+instance ToJSON OptionSubcommandOrGroup where
+  toJSON OptionSubcommandGroup {..} =
+    object
+      [ ("type", Number 2),
+        ("name", toJSON optionSubcommandGroupName),
+        ("name_localizations", toJSON optionSubcommandGroupLocalizedName),
+        ("description", toJSON optionSubcommandGroupDescription),
+        ("description_localizations", toJSON optionSubcommandGroupLocalizedDescription),
+        ("options", toJSON optionSubcommandGroupOptions)
+      ]
+  toJSON (OptionSubcommandOrGroupSubcommand a) = toJSON a
+
+
+data OptionSubcommand = OptionSubcommand
+  { 
+    optionSubcommandName :: T.Text,
+    
+    optionSubcommandLocalizedName :: Maybe LocalizedText,
+    
+    optionSubcommandDescription :: T.Text,
+    
+    optionSubcommandLocalizedDescription :: Maybe LocalizedText,
+    
+    optionSubcommandOptions :: [OptionValue]
+  }
+  deriving (Show, Eq, Read)
+
+instance FromJSON OptionSubcommand where
+  parseJSON =
+    withObject
+      "OptionSubcommand"
+      ( \v -> do
+          t <- v .: "type" :: Parser Int
+          case t of
+            1 ->
+              OptionSubcommand
+                <$> v .: "name"
+                <*> v .:? "name_localizations"
+                <*> v .: "description"
+                <*> v .:? "description_localizations"
+                <*> v .:? "options" .!= []
+            _ -> fail "unexpected subcommand type"
+      )
+
+instance ToJSON OptionSubcommand where
+  toJSON OptionSubcommand {..} =
+    object
+      [ ("type", Number 1),
+        ("name", toJSON optionSubcommandName),
+        ("name_localizations", toJSON optionSubcommandLocalizedName),
+        ("description", toJSON optionSubcommandDescription),
+        ("description_localizations", toJSON optionSubcommandLocalizedDescription),
+        ("options", toJSON optionSubcommandOptions)
+      ]
+
+
+data OptionValue
+  = OptionValueString
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool,
+        
+        optionValueStringChoices :: AutocompleteOrChoice T.Text,
+        
+        optionValueStringMinLen :: Maybe Integer,
+        
+        optionValueStringMaxLen :: Maybe Integer
+      }
+  | OptionValueInteger
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool,
+        
+        optionValueIntegerChoices :: AutocompleteOrChoice Integer,
+        
+        optionValueIntegerMinVal :: Maybe Integer,
+        
+        optionValueIntegerMaxVal :: Maybe Integer
+      }
+  | OptionValueBoolean
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool
+      }
+  | OptionValueUser
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool
+      }
+  | OptionValueChannel
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool,
+        
+        optionValueChannelTypes :: Maybe [ChannelTypeOption]
+      }
+  | OptionValueRole
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool
+      }
+  | OptionValueMentionable
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool
+      }
+  | OptionValueNumber
+      { 
+        optionValueName :: T.Text,
+        
+        optionValueLocalizedName :: Maybe LocalizedText,
+        
+        optionValueDescription :: T.Text,
+        
+        optionValueLocalizedDescription :: Maybe LocalizedText,
+        
+        optionValueRequired :: Bool,
+        
+        optionValueNumberChoices :: AutocompleteOrChoice Number,
+        
+        optionValueNumberMinVal :: Maybe Number,
+        
+        optionValueNumberMaxVal :: Maybe Number
+      }
+  deriving (Show, Eq, Read)
+
+instance FromJSON OptionValue where
+  parseJSON =
+    withObject
+      "OptionValue"
+      ( \v -> do
+          name <- v .: "name"
+          lname <- v .:? "name_localizations"
+          desc <- v .: "description"
+          ldesc <- v .:? "description_localizations"
+          required <- v .:? "required" .!= False
+          t <- v .: "type" :: Parser Int
+          case t of
+            3 ->
+              OptionValueString name lname desc ldesc required
+                <$> parseJSON (Object v)
+                <*> v .:? "min_length"
+                <*> v .:? "max_length"
+            4 ->
+              OptionValueInteger name lname desc ldesc required
+                <$> parseJSON (Object v)
+                <*> v .:? "min_value"
+                <*> v .:? "max_value"
+            10 ->
+              OptionValueNumber name lname desc ldesc required
+                <$> parseJSON (Object v)
+                <*> v .:? "min_value"
+                <*> v .:? "max_value"
+            7 ->
+              OptionValueChannel name lname desc ldesc required
+                <$> v .:? "channel_types"
+            5 -> return $ OptionValueBoolean name lname desc ldesc required
+            6 -> return $ OptionValueUser name lname desc ldesc required
+            8 -> return $ OptionValueRole name lname desc ldesc required
+            9 -> return $ OptionValueMentionable name lname desc ldesc required
+            _ -> fail "unknown application command option value type"
+      )
+
+instance ToJSON OptionValue where
+  toJSON OptionValueString {..} =
+    object
+      [ ("type", Number 3),
+        ("name", toJSON optionValueName),
+        ("description", toJSON optionValueDescription),
+        ("name_localizations", toJSON optionValueLocalizedName),
+        ("description_localizations", toJSON optionValueLocalizedDescription),
+        ("required", toJSON optionValueRequired),
+        ("min_length", toJSON optionValueStringMinLen),
+        ("max_length", toJSON optionValueStringMaxLen),
+        choiceOrAutocompleteToJSON optionValueStringChoices
+      ]
+  toJSON OptionValueInteger {..} =
+    object
+      [ ("type", Number 4),
+        ("name", toJSON optionValueName),
+        ("description", toJSON optionValueDescription),
+        ("name_localizations", toJSON optionValueLocalizedName),
+        ("description_localizations", toJSON optionValueLocalizedDescription),
+        ("required", toJSON optionValueRequired),
+        ("min_value", toJSON optionValueIntegerMinVal),
+        ("max_value", toJSON optionValueIntegerMaxVal),
+        choiceOrAutocompleteToJSON optionValueIntegerChoices
+      ]
+  toJSON OptionValueNumber {..} =
+    object
+      [ ("type", Number 10),
+        ("name", toJSON optionValueName),
+        ("description", toJSON optionValueDescription),
+        ("name_localizations", toJSON optionValueLocalizedName),
+        ("description_localizations", toJSON optionValueLocalizedDescription),
+        ("required", toJSON optionValueRequired),
+        ("min_value", toJSON optionValueNumberMinVal),
+        ("max_value", toJSON optionValueNumberMaxVal),
+        choiceOrAutocompleteToJSON optionValueNumberChoices
+      ]
+  toJSON OptionValueChannel {..} =
+    object
+      [ ("type", Number 7),
+        ("name", toJSON optionValueName),
+        ("description", toJSON optionValueDescription),
+        ("name_localizations", toJSON optionValueLocalizedName),
+        ("description_localizations", toJSON optionValueLocalizedDescription),
+        ("required", toJSON optionValueRequired),
+        ("channel_types", toJSON optionValueChannelTypes)
+      ]
+  toJSON acov =
+    object
+      [ ("type", Number (t acov)),
+        ("name", toJSON $ optionValueName acov),
+        ("description", toJSON $ optionValueDescription acov),
+        ("name_localizations", toJSON $ optionValueLocalizedName acov),
+        ("description_localizations", toJSON $ optionValueLocalizedDescription acov),
+        ("required", toJSON $ optionValueRequired acov)
+      ]
+    where
+      t OptionValueBoolean {} = 5
+      t OptionValueUser {} = 6
+      t OptionValueRole {} = 8
+      t OptionValueMentionable {} = 9
+      t _ = -1
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+data CreateApplicationCommand
+  = CreateApplicationCommandChatInput
+      { 
+        createName :: T.Text,
+        
+        createLocalizedName :: Maybe LocalizedText,
+        
+        createDescription :: T.Text,
+        
+        createLocalizedDescription :: Maybe LocalizedText,
+        
+        createOptions :: Maybe Options,
+        
+        
+        
+        createDefaultMemberPermissions :: Maybe T.Text,
+        
+        createDMPermission :: Maybe Bool
+      }
+  | CreateApplicationCommandUser
+      { 
+        createName :: T.Text,
+        
+        createLocalizedName :: Maybe LocalizedText,
+        
+        
+        
+        createDefaultMemberPermissions :: Maybe T.Text,
+        
+        createDMPermission :: Maybe Bool
+      }
+  | CreateApplicationCommandMessage
+      { 
+        createName :: T.Text,
+        
+        createLocalizedName :: Maybe LocalizedText,
+        
+        
+        
+        createDefaultMemberPermissions :: Maybe T.Text,
+        
+        createDMPermission :: Maybe Bool
+      }
+  deriving (Show, Eq, Read)
+
+instance ToJSON CreateApplicationCommand where
+  toJSON CreateApplicationCommandChatInput {..} =
+    objectFromMaybes
+      [ "name" .== createName,
+        "name_localizations" .=? createLocalizedName,
+        "description" .== createDescription,
+        "description_localizations" .=? createLocalizedDescription,
+        "options" .=? createOptions,
+        "default_member_permissions" .== createDefaultMemberPermissions,
+        "dm_permission" .== createDMPermission,
+        "type" .== Number 1
+      ]
+  toJSON CreateApplicationCommandUser {..} =
+    objectFromMaybes
+      [ "name" .== createName,
+        "name_localizations" .=? createLocalizedName,
+        "default_member_permissions" .== createDefaultMemberPermissions,
+        "dm_permission" .== createDMPermission,
+        "type" .== Number 2
+      ]
+  toJSON CreateApplicationCommandMessage {..} =
+    objectFromMaybes
+      [ "name" .== createName,
+        "name_localizations" .=? createLocalizedName,
+        "default_member_permissions" .== createDefaultMemberPermissions,
+        "dm_permission" .== createDMPermission,
+        "type" .== Number 3
+      ]
+
+nameIsValid :: Bool -> T.Text -> Bool
+nameIsValid isChatInput name = l >= 1 && l <= 32 && isChatInput <= T.all validChar name
+  where
+    l = T.length name
+    validChar c = c == '-' || c == '_' || isLower c || isNumber c
+
+
+
+
+
+createChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand
+createChatInput name desc
+  | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name Nothing desc Nothing Nothing Nothing Nothing
+  | otherwise = Nothing
+
+
+
+createUser :: T.Text -> Maybe CreateApplicationCommand
+createUser name
+  | nameIsValid False name = Just $ CreateApplicationCommandUser name Nothing Nothing Nothing
+  | otherwise = Nothing
+
+
+
+createMessage :: T.Text -> Maybe CreateApplicationCommand
+createMessage name
+  | nameIsValid False name = Just $ CreateApplicationCommandMessage name Nothing Nothing Nothing
+  | otherwise = Nothing
+
+
+
+
+
+
+data EditApplicationCommand
+  = EditApplicationCommandChatInput
+      { editName :: Maybe T.Text,
+        editLocalizedName :: Maybe LocalizedText,
+        editDescription :: Maybe T.Text,
+        editLocalizedDescription :: Maybe LocalizedText,
+        editOptions :: Maybe Options,
+        editDefaultMemberPermissions :: Maybe T.Text,
+        editDMPermission :: Maybe Bool
+      }
+  | EditApplicationCommandUser
+      { editName :: Maybe T.Text,
+        editLocalizedName :: Maybe LocalizedText,
+        editDefaultMemberPermissions :: Maybe T.Text,
+        editDMPermission :: Maybe Bool
+      }
+  | EditApplicationCommandMessage
+      { editName :: Maybe T.Text,
+        editLocalizedName :: Maybe LocalizedText,
+        editDefaultMemberPermissions :: Maybe T.Text,
+        editDMPermission :: Maybe Bool
+      }
+
+defaultEditApplicationCommand :: Int -> EditApplicationCommand
+defaultEditApplicationCommand 2 = EditApplicationCommandUser Nothing Nothing Nothing Nothing
+defaultEditApplicationCommand 3 = EditApplicationCommandMessage Nothing Nothing Nothing Nothing
+defaultEditApplicationCommand _ = EditApplicationCommandChatInput Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+instance ToJSON EditApplicationCommand where
+  toJSON EditApplicationCommandChatInput {..} =
+    objectFromMaybes
+      [ "name" .=? editName,
+        "name_localization" .=? editLocalizedName,
+        "description" .=? editDescription,
+        "description_localization" .=? editLocalizedDescription,
+        "options" .=? editOptions,
+        "default_member_permissions" .=? editDefaultMemberPermissions,
+        "dm_permission" .=? editDMPermission,
+        "type" .== Number 1
+      ]
+  toJSON EditApplicationCommandUser {..} =
+    objectFromMaybes
+      [ "name" .=? editName,
+        "name_localization" .=? editLocalizedName,
+        "default_member_permissions" .=? editDefaultMemberPermissions,
+        "dm_permission" .=? editDMPermission,
+        "type" .== Number 2
+      ]
+  toJSON EditApplicationCommandMessage {..} =
+    objectFromMaybes
+      [ "name" .=? editName,
+        "name_localization" .=? editLocalizedName,
+        "default_member_permissions" .=? editDefaultMemberPermissions,
+        "dm_permission" .=? editDMPermission,
+        "type" .== Number 3
+      ]
+
+data Choice a = Choice
+  { 
+    choiceName :: T.Text,
+    
+    choiceLocalizedName :: Maybe LocalizedText,
+    
+    choiceValue :: a
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance Functor Choice where
+  fmap f (Choice s l a) = Choice s l (f a)
+
+instance (ToJSON a) => ToJSON (Choice a) where
+  toJSON Choice {..} =
+    object
+      [ ("name", toJSON choiceName),
+        ("value", toJSON choiceValue),
+        ("name_localizations", toJSON choiceLocalizedName)
+      ]
+
+instance (FromJSON a) => FromJSON (Choice a) where
+  parseJSON =
+    withObject
+      "Choice"
+      ( \v ->
+          Choice
+            <$> v .: "name"
+            <*> v .:? "name_localizations"
+            <*> v .: "value"
+      )
+
+type AutocompleteOrChoice a = Either Bool [Choice a]
+
+instance {-# OVERLAPPING #-} (FromJSON a) => FromJSON (AutocompleteOrChoice a) where
+  parseJSON =
+    withObject
+      "AutocompleteOrChoice"
+      ( \v -> do
+          mcs <- v .:! "choices"
+          case mcs of
+            Nothing -> Left <$> v .:? "autocomplete" .!= False
+            Just cs -> return $ Right cs
+      )
+
+choiceOrAutocompleteToJSON :: (ToJSON a) => AutocompleteOrChoice a -> Pair
+choiceOrAutocompleteToJSON (Left b) = ("autocomplete", toJSON b)
+choiceOrAutocompleteToJSON (Right cs) = ("choices", toJSON cs)
+
+data GuildApplicationCommandPermissions = GuildApplicationCommandPermissions
+  { 
+    guildApplicationCommandPermissionsId :: ApplicationCommandId,
+    
+    guildApplicationCommandPermissionsApplicationId :: ApplicationId,
+    
+    guildApplicationCommandPermissionsGuildId :: GuildId,
+    
+    guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON GuildApplicationCommandPermissions where
+  parseJSON =
+    withObject
+      "GuildApplicationCommandPermissions"
+      ( \v ->
+          GuildApplicationCommandPermissions
+            <$> v .: "id"
+            <*> v .: "application_id"
+            <*> v .: "guild_id"
+            <*> v .: "permissions"
+      )
+
+instance ToJSON GuildApplicationCommandPermissions where
+  toJSON GuildApplicationCommandPermissions {..} =
+    objectFromMaybes
+      [ "id" .== guildApplicationCommandPermissionsId,
+        "application_id" .== guildApplicationCommandPermissionsApplicationId,
+        "guild_id" .== guildApplicationCommandPermissionsGuildId,
+        "permissions" .== guildApplicationCommandPermissionsPermissions
+      ]
+
+
+
+data ApplicationCommandPermissions = ApplicationCommandPermissions
+  { 
+    applicationCommandPermissionsId :: Snowflake,
+    
+    applicationCommandPermissionsType :: Integer,
+    
+    applicationCommandPermissionsPermission :: Bool
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ApplicationCommandPermissions where
+  parseJSON =
+    withObject
+      "ApplicationCommandPermissions"
+      ( \v ->
+          ApplicationCommandPermissions
+            <$> v .: "id"
+            <*> v .: "type"
+            <*> v .: "permission"
+      )
+
+instance ToJSON ApplicationCommandPermissions where
+  toJSON ApplicationCommandPermissions {..} =
+    objectFromMaybes
+      [ "id" .== applicationCommandPermissionsId,
+        "type" .== applicationCommandPermissionsType,
+        "permission" .== applicationCommandPermissionsPermission
+      ]
+
+
+
+type Locale = T.Text
+
+
+type LocalizedText = Map Locale T.Text

+ src/Sigmacord/Internal/Types/Channel.hs view
@@ -0,0 +1,879 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+
+module Sigmacord.Internal.Types.Channel (
+    Channel (..)
+  , channelIsInGuild
+  , Overwrite (..)
+  , ThreadMetadata (..)
+  , ThreadMember (..)
+  , ThreadListSyncFields (..)
+  , ThreadMembersUpdateFields (..)
+  , Message (..)
+  , AllowedMentions (..)
+  , MessageReaction (..)
+  , Attachment (..)
+  , Nonce (..)
+  , MessageReference (..)
+  , MessageType (..)
+  , MessageActivity (..)
+  , MessageActivityType (..)
+  , MessageFlag (..)
+  , MessageFlags (..)
+  , MessageInteraction (..)
+
+  , ChannelTypeOption (..)
+  ) where
+
+import Control.Applicative (empty)
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.Default (Default, def)
+import Data.Text (Text)
+import Data.Time.Clock
+import qualified Data.Text as T
+import Data.Bits
+import Data.Data (Data)
+
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.User (User(..), GuildMember)
+import Sigmacord.Internal.Types.Embed
+import Sigmacord.Internal.Types.Components (ActionRow)
+import Sigmacord.Internal.Types.Emoji
+
+
+data Channel
+  
+  = ChannelText
+      { channelId          :: ChannelId         
+                                                
+      , channelGuild       :: GuildId           
+      , channelName        :: T.Text            
+      , channelPosition    :: Integer           
+      , channelPermissions :: [Overwrite]       
+      , channelUserRateLimit :: Integer         
+      , channelNSFW        :: Bool              
+      , channelTopic       :: T.Text            
+      , channelLastMessage :: Maybe MessageId   
+                                                
+      , channelParentId    :: Maybe ParentId    
+      }
+  
+  | ChannelNews
+      { channelId          :: ChannelId       
+      , channelGuild       :: GuildId         
+      , channelName        :: T.Text          
+      , channelPosition    :: Integer         
+      , channelPermissions :: [Overwrite]     
+      , channelNSFW        :: Bool            
+      , channelTopic       :: T.Text          
+      , channelLastMessage :: Maybe MessageId 
+      , channelParentId    :: Maybe ParentId  
+      }
+   
+  | ChannelStorePage
+      { channelId          :: ChannelId      
+      , channelGuild       :: GuildId        
+      , channelName        :: T.Text         
+      , channelPosition    :: Integer        
+      , channelNSFW        :: Bool           
+      , channelPermissions :: [Overwrite]    
+      , channelParentId    :: Maybe ParentId 
+      }
+  
+  | ChannelVoice
+      { channelId          :: ChannelId       
+      , channelGuild       :: GuildId         
+      , channelName        :: T.Text          
+      , channelPosition    :: Integer         
+      , channelPermissions :: [Overwrite]     
+      , channelNSFW        :: Bool            
+      , channelBitRate     :: Integer         
+      , channelUserLimit   :: Integer         
+      , channelParentId    :: Maybe ParentId  
+      }
+  
+  
+  | ChannelDirectMessage
+      { channelId          :: ChannelId       
+      , channelRecipients  :: [User]          
+      , channelLastMessage :: Maybe MessageId 
+      }
+  
+  | ChannelGroupDM
+      { channelId          :: ChannelId       
+      , channelRecipients  :: [User]          
+      , channelLastMessage :: Maybe MessageId 
+      }
+  
+  | ChannelGuildCategory
+      { channelId          :: ChannelId   
+      , channelGuild       :: GuildId     
+      , channelName        :: T.Text      
+      , channelPosition    :: Integer     
+      , channelPermissions :: [Overwrite] 
+      }
+  
+  | ChannelStage
+      { channelId          :: ChannelId 
+      , channelGuild       :: GuildId   
+      , channelStageId     :: StageId   
+      , channelStageTopic  :: Text      
+      }
+  
+  | ChannelNewsThread
+      { channelId          :: ChannelId               
+      , channelGuild       :: GuildId                 
+      , channelThreadName  :: Maybe T.Text            
+      , channelUserRateLimitThread :: Maybe Integer   
+      , channelLastMessage :: Maybe MessageId         
+                                                      
+      , channelParentId    :: Maybe ParentId          
+      , channelThreadMetadata :: Maybe ThreadMetadata 
+      , channelThreadMember :: Maybe ThreadMember     
+      }
+  
+  | ChannelPublicThread
+      { channelId          :: ChannelId               
+      , channelGuild       :: GuildId                 
+      , channelThreadName  :: Maybe T.Text            
+      , channelUserRateLimitThread :: Maybe Integer   
+      , channelLastMessage :: Maybe MessageId         
+                                                      
+      , channelParentId    :: Maybe ParentId          
+      , channelThreadMetadata :: Maybe ThreadMetadata 
+      , channelThreadMember :: Maybe ThreadMember     
+      }
+  
+  | ChannelPrivateThread
+      { channelId          :: ChannelId               
+      , channelGuild       :: GuildId                 
+      , channelThreadName  :: Maybe T.Text            
+      , channelUserRateLimitThread :: Maybe Integer   
+      , channelLastMessage :: Maybe MessageId         
+                                                      
+      , channelParentId    :: Maybe ParentId          
+      , channelThreadMetadata :: Maybe ThreadMetadata 
+      , channelThreadMember :: Maybe ThreadMember     
+      }
+  
+  | ChannelUnknownType
+      { channelId          :: ChannelId 
+      , channelJSON        :: Text      
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Channel where
+  parseJSON = withObject "Channel" $ \o -> do
+    type' <- (o .: "type") :: Parser Int
+    case type' of
+      0 ->
+        ChannelText  <$> o .:  "id"
+                     <*> o .:? "guild_id" .!= 0
+                     <*> o .:  "name"
+                     <*> o .:  "position"
+                     <*> o .:  "permission_overwrites"
+                     <*> o .:  "rate_limit_per_user"
+                     <*> o .:? "nsfw" .!= False
+                     <*> o .:? "topic" .!= ""
+                     <*> o .:? "last_message_id"
+                     <*> o .:? "parent_id"
+      1 ->
+        ChannelDirectMessage <$> o .:  "id"
+                             <*> o .:  "recipients"
+                             <*> o .:? "last_message_id"
+      2 ->
+        ChannelVoice <$> o .:  "id"
+                     <*> o .:? "guild_id" .!= 0
+                     <*> o .:  "name"
+                     <*> o .:  "position"
+                     <*> o .:  "permission_overwrites"
+                     <*> o .:? "nsfw" .!= False
+                     <*> o .:  "bitrate"
+                     <*> o .:  "user_limit"
+                     <*> o .:? "parent_id"
+      3 ->
+        ChannelGroupDM <$> o .:  "id"
+                       <*> o .:  "recipients"
+                       <*> o .:? "last_message_id"
+      4 ->
+        ChannelGuildCategory <$> o .: "id"
+                             <*> o .:? "guild_id" .!= 0
+                             <*> o .:  "name"
+                             <*> o .:  "position"
+                             <*> o .:  "permission_overwrites"
+      5 ->
+        ChannelNews <$> o .:  "id"
+                    <*> o .:? "guild_id" .!= 0
+                    <*> o .:  "name"
+                    <*> o .:  "position"
+                    <*> o .:  "permission_overwrites"
+                    <*> o .:? "nsfw" .!= False
+                    <*> o .:? "topic" .!= ""
+                    <*> o .:? "last_message_id"
+                    <*> o .:? "parent_id"
+      6 ->
+        ChannelStorePage <$> o .:  "id"
+                         <*> o .:? "guild_id" .!= 0
+                         <*> o .:  "name"
+                         <*> o .:  "position"
+                         <*> o .:? "nsfw" .!= False
+                         <*> o .:  "permission_overwrites"
+                         <*> o .:? "parent_id"
+      10 -> ChannelNewsThread <$> o.: "id"
+                              <*> o .:? "guild_id" .!= 0
+                              <*> o .:? "name"
+                              <*> o .:? "rate_limit_per_user"
+                              <*> o .:? "last_message_id"
+                              <*> o .:? "parent_id"
+                              <*> o .:? "thread_metadata"
+                              <*> o .:? "member"
+      11 -> ChannelPublicThread <$> o.: "id"
+                                <*> o .:? "guild_id" .!= 0
+                                <*> o .:? "name"
+                                <*> o .:? "rate_limit_per_user"
+                                <*> o .:? "last_message_id"
+                                <*> o .:? "parent_id"
+                                <*> o .:? "thread_metadata"
+                                <*> o .:? "member"
+      12 -> ChannelPrivateThread <$> o.: "id"
+                                 <*> o .:? "guild_id" .!= 0
+                                 <*> o .:? "name"
+                                 <*> o .:? "rate_limit_per_user"
+                                 <*> o .:? "last_message_id"
+                                 <*> o .:? "parent_id"
+                                 <*> o .:? "thread_metadata"
+                                 <*> o .:? "member"
+      13 ->
+        ChannelStage <$> o .:  "id"
+                     <*> o .:? "guild_id" .!= 0
+                     <*> o .:  "id"
+                     <*> o .:? "topic" .!= ""
+      _ -> ChannelUnknownType <$> o .:  "id"
+                              <*> pure (T.pack (show o))
+
+instance ToJSON Channel where
+  toJSON ChannelText{..} = objectFromMaybes
+              [ "type" .== Number 0
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .== channelName
+              , "position" .== channelPosition
+              , "rate_limit_per_user" .== channelUserRateLimit
+              , "nsfw" .== channelNSFW
+              , "permission_overwrites" .== channelPermissions
+              , "topic" .== channelTopic
+              , "last_message_id" .=? channelLastMessage
+              , "parent_id" .== channelParentId
+              ]
+  toJSON ChannelNews{..} = objectFromMaybes
+              [ "type" .== Number 5
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .== channelName
+              , "position" .== channelPosition
+              , "permission_overwrites" .== channelPermissions
+              , "nsfw" .== channelNSFW
+              , "topic" .== channelTopic
+              , "last_message_id" .=? channelLastMessage
+              , "parent_id" .=? channelParentId
+              ]
+  toJSON ChannelStorePage{..} = objectFromMaybes
+              [ "type" .== Number 6
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .== channelName
+              , "nsfw" .== channelNSFW
+              , "position" .== channelPosition
+              , "permission_overwrites" .== channelPermissions
+              ]
+  toJSON ChannelDirectMessage{..} = objectFromMaybes
+              [ "type" .== Number 1
+              , "id" .== channelId
+              , "recipients" .== channelRecipients
+              , "last_message_id" .=? channelLastMessage
+              ]
+  toJSON ChannelVoice{..} = objectFromMaybes
+              [ "type" .== Number 2
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .== channelName
+              , "position" .== channelPosition
+              , "nsfw" .== channelNSFW
+              , "permission_overwrites" .== channelPermissions
+              , "bitrate" .== channelBitRate
+              , "user_limit" .== channelUserLimit
+              ]
+  toJSON ChannelGroupDM{..} = objectFromMaybes
+              [ "type" .== Number 3
+              , "id" .== channelId
+              , "recipients" .== channelRecipients
+              , "last_message_id" .=? channelLastMessage
+              ]
+  toJSON ChannelGuildCategory{..} = objectFromMaybes
+              [ "type" .== Number 4
+              , "id" .== channelId
+              , "name" .== channelName
+              , "guild_id" .== channelGuild
+              ]
+  toJSON ChannelStage{..} = objectFromMaybes
+              [ "type" .== Number 13
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "channel_id" .== channelStageId
+              , "topic" .== channelStageTopic
+              ]
+  toJSON ChannelNewsThread{..} = objectFromMaybes
+              [ "type" .== Number 10
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .=? channelThreadName
+              , "rate_limit_per_user" .=? channelUserRateLimitThread
+              , "last_message_id" .=? channelLastMessage
+              , "parent_id" .== channelParentId
+              , "thread_metadata" .=? channelThreadMetadata
+              , "member" .=? channelThreadMember
+              ]
+  toJSON ChannelPublicThread{..} = objectFromMaybes
+              [ "type" .== Number 11
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .=? channelThreadName
+              , "rate_limit_per_user" .=? channelUserRateLimitThread
+              , "last_message_id" .=? channelLastMessage
+              , "parent_id" .== channelParentId
+              , "thread_metadata" .=? channelThreadMetadata
+              , "member" .=? channelThreadMember
+              ]
+  toJSON ChannelPrivateThread{..} = objectFromMaybes
+              [ "type" .== Number 12
+              , "id" .== channelId
+              , "guild_id" .== channelGuild
+              , "name" .=? channelThreadName
+              , "rate_limit_per_user" .=? channelUserRateLimitThread
+              , "last_message_id" .=? channelLastMessage
+              , "parent_id" .== channelParentId
+              , "thread_metadata" .=? channelThreadMetadata
+              , "member" .=? channelThreadMember
+              ]
+  toJSON ChannelUnknownType{..} = objectFromMaybes
+              [ "id" .== channelId
+              , "json" .== channelJSON
+              ]
+
+
+channelIsInGuild :: Channel -> Bool
+channelIsInGuild c = case c of
+        ChannelGuildCategory{} -> True
+        ChannelText{} -> True
+        ChannelVoice{} -> True
+        ChannelNews{} -> True
+        ChannelStorePage{} -> True
+        ChannelNewsThread{} -> True
+        ChannelPublicThread{} -> True
+        ChannelPrivateThread{} -> True
+        _ -> False
+
+
+data Overwrite = Overwrite
+  { overwriteId    :: Either RoleId UserId 
+  , overwriteAllow :: T.Text               
+  , overwriteDeny  :: T.Text               
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Overwrite where
+  parseJSON = withObject "Overwrite" $ \o -> do
+    t <- o .: "type"
+    i <- case (t :: Int) of
+      0 -> Left <$> o .: "id"
+      1 -> Right <$> o .: "id"
+      _ -> error "Type field can only be 0 (role id) or 1 (user id)"
+    Overwrite i
+              <$> o .: "allow"
+              <*> o .: "deny"
+
+instance ToJSON Overwrite where
+  toJSON Overwrite{..} = object
+              [ ("id",     toJSON $ either unId unId overwriteId)
+              , ("type",   toJSON (either (const 0) (const 1) overwriteId :: Int))
+              , ("allow",  toJSON overwriteAllow)
+              , ("deny",   toJSON overwriteDeny)
+              ]
+
+
+data ThreadMetadata = ThreadMetadata
+ { threadMetadataArchived :: Bool 
+ , threadMetadataAutoArchive :: Integer 
+ , threadMetadataArchiveTime :: UTCTime 
+ , threadMetadataLocked :: Bool 
+ , threadMetadataInvitable :: Maybe Bool 
+ , threadMetadataCreateTime :: Maybe UTCTime 
+ } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ThreadMetadata where
+  parseJSON = withObject "ThreadMetadata" $ \o ->
+    ThreadMetadata <$> o .:  "archived"
+                   <*> o .:  "auto_archive_duration"
+                   <*> o .:  "archive_timestamp"
+                   <*> o .:  "locked"
+                   <*> o .:? "invitable"
+                   <*> o .:? "create_timestamp"
+
+instance ToJSON ThreadMetadata where
+  toJSON ThreadMetadata{..} = objectFromMaybes
+              [ "archived" .== threadMetadataArchived
+              , "auto_archive_duration" .== threadMetadataAutoArchive
+              , "archive_timestamp" .== threadMetadataArchiveTime
+              , "locked" .== threadMetadataLocked
+              , "invitable" .=? threadMetadataInvitable
+              , "create_timestamp" .== threadMetadataCreateTime
+              ]
+
+
+data ThreadMember = ThreadMember
+ { threadMemberThreadId :: Maybe ChannelId 
+ , threadMemberUserId   :: Maybe UserId    
+ , threadMemberJoinTime :: UTCTime         
+ , threadMemberFlags    :: Integer         
+ } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ThreadMember where
+  parseJSON = withObject "ThreadMember" $ \o ->
+    ThreadMember <$> o .:? "id"
+                 <*> o .:? "user_id"
+                 <*> o .:  "join_timestamp"
+                 <*> o .:  "flags"
+
+instance ToJSON ThreadMember where
+  toJSON ThreadMember{..} = objectFromMaybes
+              [ "id" .=? threadMemberThreadId
+              , "user_id" .=? threadMemberUserId
+              , "join_timestamp" .== threadMemberJoinTime
+              , "flags" .== threadMemberFlags
+              ]
+
+
+data ThreadListSyncFields = ThreadListSyncFields
+  { threadListSyncFieldsGuildId :: GuildId
+  , threadListSyncFieldsChannelIds :: Maybe [ChannelId]
+  , threadListSyncFieldsThreads :: [Channel]
+  , threadListSyncFieldsThreadMembers :: [ThreadMember]
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ThreadListSyncFields where
+  parseJSON = withObject "ThreadListSyncFields" $ \o ->
+    ThreadListSyncFields <$> o .: "guild_id"
+                         <*> o .:? "channel_ids"
+                         <*> o .:  "threads"
+                         <*> o .:  "members"
+
+data ThreadMembersUpdateFields = ThreadMembersUpdateFields
+  { threadMembersUpdateFieldsThreadId :: ChannelId
+  , threadMembersUpdateFieldsGuildId :: GuildId
+  , threadMembersUpdateFieldsMemberCount :: Integer
+  , threadMembersUpdateFieldsAddedMembers :: Maybe [ThreadMember]
+  , threadMembersUpdateFieldsRemovedMembers :: Maybe [UserId]
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ThreadMembersUpdateFields where
+  parseJSON = withObject "ThreadMembersUpdateFields" $ \o ->
+    ThreadMembersUpdateFields <$> o .:  "id"
+                              <*> o .:  "guild_id"
+                              <*> o .:  "member_count"
+                              <*> o .:? "added_members"
+                              <*> o .:? "removed_member_ids"
+
+
+data Message = Message
+  { messageId                 :: MessageId                
+  , messageChannelId          :: ChannelId                
+                                                          
+  , messageGuildId            :: Maybe GuildId            
+  , messageAuthor             :: User                     
+                                                          
+  , messageMember             :: Maybe GuildMember        
+  , messageContent            :: Text                     
+  , messageTimestamp          :: UTCTime                  
+  , messageEdited             :: Maybe UTCTime            
+  , messageTts                :: Bool                     
+                                                          
+  , messageEveryone           :: Bool                     
+                                                          
+  , messageMentions           :: [User]                   
+                                                          
+  , messageMentionRoles       :: [RoleId]                 
+                                                          
+  , messageAttachments        :: [Attachment]             
+  , messageEmbeds             :: [Embed]                  
+  , messageReactions          :: [MessageReaction]        
+  , messageNonce              :: Maybe Nonce              
+                                                          
+  , messagePinned             :: Bool                     
+  , messageWebhookId          :: Maybe WebhookId          
+  , messageType               :: MessageType              
+  , messageActivity           :: Maybe MessageActivity    
+  , messageApplicationId      :: Maybe ApplicationId      
+  , messageReference          :: Maybe MessageReference   
+  , messageFlags              :: Maybe MessageFlags       
+  , messageReferencedMessage  :: Maybe Message            
+  , messageInteraction        :: Maybe MessageInteraction 
+  , messageThread             :: Maybe Channel            
+  , messageComponents         :: Maybe [ActionRow]        
+  , messageStickerItems       :: Maybe [StickerItem]      
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Message where
+  parseJSON = withObject "Message" $ \o ->
+    Message <$> o .:  "id"
+            <*> o .:  "channel_id"
+            <*> o .:? "guild_id" .!= Nothing
+            <*> (do isW <- o .:? "webhook_id"
+                    a <- o .: "author"
+                    case isW :: Maybe WebhookId of
+                      Nothing -> pure a
+                      Just _ -> pure $ a { userIsWebhook = True })
+            <*> o .:? "member"
+            <*> o .:? "content" .!= ""
+            <*> o .:? "timestamp" .!= epochTime
+            <*> o .:? "edited_timestamp"
+            <*> o .:? "tts" .!= False
+            <*> o .:? "mention_everyone" .!= False
+            <*> o .:? "mentions" .!= []
+            <*> o .:? "mention_roles" .!= []
+            <*> o .:? "attachments" .!= []
+            <*> o .:  "embeds"
+            <*> o .:? "reactions" .!= []
+            <*> o .:? "nonce"
+            <*> o .:? "pinned" .!= False
+            <*> o .:? "webhook_id"
+            <*> o .:  "type"
+            <*> o .:? "activity"
+            
+            <*> o .:? "application_id"
+            <*> o .:? "message_reference" .!= Nothing
+            <*> o .:? "flags"
+            <*> o .:? "referenced_message" .!= Nothing
+            <*> o .:? "interaction"
+            <*> o .:? "thread"
+            <*> o .:? "components"
+            <*> o .:? "sticker_items"
+
+
+instance ToJSON Message where
+  toJSON Message {..} = objectFromMaybes
+      [ "id" .== messageId
+      , "channel_id" .== messageChannelId
+      , "guild_id" .=? messageGuildId
+      , "author" .== messageAuthor
+      , "member" .=? messageMember
+      , "content" .== messageContent
+      , "timestamp" .== messageTimestamp
+      , "edited_timestamp" .=? messageEdited
+      , "tts" .== messageTts
+      , "mention_everyone" .== messageEveryone
+      , "mentions" .== messageMentions
+      , "mention_roles" .== messageMentionRoles
+      , "attachments" .== messageAttachments
+      , "embeds" .== messageEmbeds
+      , "reactions" .== messageReactions
+      , "nonce" .=? messageNonce
+      , "pinned" .== messagePinned
+      , "webhook_id" .=? messageWebhookId
+      , "type" .== messageType
+      , "activity" .=? messageActivity
+      
+      , "application_id" .=? messageApplicationId
+      , "message_reference" .=? messageReference
+      , "flags" .=? messageFlags
+      , "referenced_message" .=? messageReferencedMessage
+      , "interaction" .=? messageInteraction
+      , "thread" .=? messageThread
+      , "components" .=? messageComponents
+      , "sticker_items" .=? messageStickerItems
+      ]
+
+
+data AllowedMentions = AllowedMentions
+  { mentionEveryone    :: Bool     
+  , mentionUsers       :: Bool     
+  , mentionRoles       :: Bool     
+  , mentionUserIds     :: [UserId] 
+  , mentionRoleIds     :: [RoleId] 
+  , mentionRepliedUser :: Bool     
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default AllowedMentions where
+  def = AllowedMentions { mentionEveryone    = False
+                        , mentionUsers       = True
+                        , mentionRoles       = True
+                        , mentionUserIds     = []
+                        , mentionRoleIds     = []
+                        , mentionRepliedUser = True
+                        }
+
+instance ToJSON AllowedMentions where
+  toJSON AllowedMentions{..} = object [
+                                 "parse" .= [name :: T.Text | (name, True) <-
+                                    [ ("everyone", mentionEveryone),
+                                      ("users",    mentionUsers && null mentionUserIds),
+                                      ("roles",    mentionRoles && null mentionRoleIds) ] ],
+                                 
+                                 
+                                 "roles"        .= mentionRoleIds,
+                                 "users"        .= mentionUserIds,
+                                 "replied_user" .= mentionRepliedUser ]
+
+
+data MessageReaction = MessageReaction
+  { messageReactionCount :: Int
+  , messageReactionMeIncluded :: Bool
+  , messageReactionEmoji :: Emoji
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON MessageReaction where
+  parseJSON = withObject "MessageReaction" $ \o ->
+    MessageReaction <$> o .: "count"
+                    <*> o .: "me"
+                    <*> o .: "emoji"
+
+instance ToJSON MessageReaction where
+  toJSON MessageReaction{..} = objectFromMaybes
+      [ "count" .== messageReactionCount
+      , "me" .== messageReactionMeIncluded
+      , "emoji" .== messageReactionEmoji
+      ]
+
+
+data Attachment = Attachment
+  { attachmentId       :: AttachmentId     
+  , attachmentFilename :: T.Text        
+  , attachmentSize     :: Integer       
+  , attachmentUrl      :: T.Text        
+  , attachmentProxy    :: T.Text        
+  , attachmentHeight   :: Maybe Integer 
+  , attachmentWidth    :: Maybe Integer 
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Attachment where
+  parseJSON = withObject "Attachment" $ \o ->
+    Attachment <$> o .:  "id"
+               <*> o .:  "filename"
+               <*> o .:  "size"
+               <*> o .:  "url"
+               <*> o .:  "proxy_url"
+               <*> o .:? "height"
+               <*> o .:? "width"
+
+instance ToJSON Attachment where
+  toJSON Attachment {..} = objectFromMaybes
+      [ "id" .== attachmentId
+      , "filename" .== attachmentFilename
+      , "size" .== attachmentSize
+      , "url" .== attachmentUrl
+      , "proxy_url" .== attachmentProxy
+      , "height" .=? attachmentHeight
+      , "width" .=? attachmentWidth
+      ]
+
+newtype Nonce = Nonce T.Text
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Nonce where
+  parseJSON (String nonce) = pure $ Nonce nonce
+  parseJSON (Number nonce) = pure . Nonce . T.pack . show $ nonce
+  parseJSON _ = empty
+
+instance ToJSON Nonce where
+  toJSON (Nonce t) = String t
+
+
+
+data MessageReference = MessageReference
+  { referenceMessageId      :: Maybe MessageId  
+  , referenceChannelId      :: Maybe ChannelId  
+  , referenceGuildId        :: Maybe GuildId    
+  , failIfNotExists         :: Bool             
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON MessageReference where
+  parseJSON = withObject "MessageReference" $ \o ->
+    MessageReference <$> o .:? "message_id"
+                     <*> o .:? "channel_id"
+                     <*> o .:? "guild_id"
+                     <*> o .:? "fail_if_not_exists" .!= True
+
+instance ToJSON MessageReference where
+  toJSON MessageReference{..} = objectFromMaybes
+              [ "message_id" .== referenceMessageId
+              , "channel_id" .== referenceChannelId
+              , "guild_id" .== referenceGuildId
+              , "fail_if_not_exists" .== failIfNotExists
+              ]
+
+instance Default MessageReference where
+  def = MessageReference { referenceMessageId = Nothing
+                         , referenceChannelId = Nothing
+                         , referenceGuildId   = Nothing
+                         , failIfNotExists    = False
+                         }
+
+
+data MessageType
+  = MessageTypeDefault
+  | MessageTypeRecipientAdd
+  | MessageTypeRecipientRemove
+  | MessageTypeCall
+  | MessageTypeChannelNameChange
+  | MessageTypeChannelIconChange
+  | MessageTypeChannelPinnedMessage
+  | MessageTypeGuildMemberJoin
+  | MessageTypeUserPremiumGuildSubscription
+  | MessageTypeUserPremiumGuildSubscriptionTier1
+  | MessageTypeUserPremiumGuildSubscriptionTier2
+  | MessageTypeUserPremiumGuildSubscriptionTier3
+  | MessageTypeChannelFollowAdd
+  | MessageTypeGuildDiscoveryDisqualified
+  | MessageTypeGuildDiscoveryRequalified
+  | MessageTypeGuildDiscoveryGracePeriodInitialWarning
+  | MessageTypeGuildDiscoveryGracePeriodFinalWarning
+  | MessageTypeThreadCreated
+  | MessageTypeReply
+  | MessageTypeChatInputCommand
+  | MessageTypeThreadStarterMessage
+  | MessageTypeGuildInviteReminder
+  | MessageTypeContextMenuCommand
+  deriving (Show, Read, Data, Eq, Ord)
+
+instance InternalSigmacordEnum MessageType where
+  SigmacordTypeStartValue = MessageTypeDefault
+  fromSigmacordType MessageTypeDefault = 0
+  fromSigmacordType MessageTypeRecipientAdd = 1
+  fromSigmacordType MessageTypeRecipientRemove = 2
+  fromSigmacordType MessageTypeCall = 3
+  fromSigmacordType MessageTypeChannelNameChange = 4
+  fromSigmacordType MessageTypeChannelIconChange = 5
+  fromSigmacordType MessageTypeChannelPinnedMessage = 6
+  fromSigmacordType MessageTypeGuildMemberJoin = 7
+  fromSigmacordType MessageTypeUserPremiumGuildSubscription = 8
+  fromSigmacordType MessageTypeUserPremiumGuildSubscriptionTier1 = 9
+  fromSigmacordType MessageTypeUserPremiumGuildSubscriptionTier2 = 10
+  fromSigmacordType MessageTypeUserPremiumGuildSubscriptionTier3 = 11
+  fromSigmacordType MessageTypeChannelFollowAdd = 12
+  fromSigmacordType MessageTypeGuildDiscoveryDisqualified = 14
+  fromSigmacordType MessageTypeGuildDiscoveryRequalified = 15
+  fromSigmacordType MessageTypeGuildDiscoveryGracePeriodInitialWarning = 16
+  fromSigmacordType MessageTypeGuildDiscoveryGracePeriodFinalWarning = 17
+  fromSigmacordType MessageTypeThreadCreated = 18
+  fromSigmacordType MessageTypeReply = 19
+  fromSigmacordType MessageTypeChatInputCommand = 20
+  fromSigmacordType MessageTypeThreadStarterMessage = 21
+  fromSigmacordType MessageTypeGuildInviteReminder = 22
+  fromSigmacordType MessageTypeContextMenuCommand = 23
+
+instance ToJSON MessageType where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON MessageType where
+  parseJSON = SigmacordTypeParseJSON "MessageType"
+
+data MessageActivity = MessageActivity
+  { messageActivityType :: MessageActivityType
+  , messageActivityPartyId :: Maybe T.Text
+  }
+  deriving (Show, Read, Data, Eq, Ord)
+
+instance FromJSON MessageActivity where
+  parseJSON = withObject "MessageActivity" $ \o ->
+    MessageActivity <$> o .:   "type"
+                     <*> o .:? "party_id"
+
+instance ToJSON MessageActivity where
+  toJSON MessageActivity{..} = objectFromMaybes
+              [ "type" .== messageActivityType
+              , "party_id" .=? messageActivityPartyId
+              ]
+
+data MessageActivityType
+  = MessageActivityTypeJoin 
+  | MessageActivityTypeSpectate 
+  | MessageActivityTypeListen 
+  | MessageActivityTypeJoinRequest 
+  deriving (Show, Read, Data, Eq, Ord)
+
+instance InternalSigmacordEnum MessageActivityType where
+  SigmacordTypeStartValue = MessageActivityTypeJoin
+  fromSigmacordType MessageActivityTypeJoin = 1
+  fromSigmacordType MessageActivityTypeSpectate = 2
+  fromSigmacordType MessageActivityTypeListen = 3
+  fromSigmacordType MessageActivityTypeJoinRequest = 4
+
+instance ToJSON MessageActivityType where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON MessageActivityType where
+  parseJSON = SigmacordTypeParseJSON "MessageActivityType"
+
+
+data MessageFlag =
+    MessageFlagCrossposted
+  | MessageFlagIsCrosspost
+  | MessageFlagSupressEmbeds
+  | MessageFlagSourceMessageDeleted
+  | MessageFlagUrgent
+  | MessageFlagHasThread
+  | MessageFlagEphemeral
+  | MessageFlagLoading
+  | MessageFlagFailedToMentionRollesInThread
+  deriving (Show, Read, Eq, Data, Ord)
+
+newtype MessageFlags = MessageFlags [MessageFlag]
+  deriving (Show, Read, Eq, Ord)
+
+instance InternalSigmacordEnum MessageFlag where
+  SigmacordTypeStartValue = MessageFlagCrossposted
+  fromSigmacordType MessageFlagCrossposted = 1 `shift` 0
+  fromSigmacordType MessageFlagIsCrosspost = 1 `shift` 1
+  fromSigmacordType MessageFlagSupressEmbeds = 1 `shift` 2
+  fromSigmacordType MessageFlagSourceMessageDeleted = 1 `shift` 3
+  fromSigmacordType MessageFlagUrgent = 1 `shift` 4
+  fromSigmacordType MessageFlagHasThread = 1 `shift` 5
+  fromSigmacordType MessageFlagEphemeral = 1 `shift` 6
+  fromSigmacordType MessageFlagLoading = 1 `shift` 7
+  fromSigmacordType MessageFlagFailedToMentionRollesInThread = 1 `shift` 8
+
+instance ToJSON MessageFlags where
+  toJSON (MessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromSigmacordType <$> fs)
+
+
+
+instance FromJSON MessageFlags where
+  parseJSON = withScientific "MessageFlags" $ \s ->
+      let i = round s
+          
+          
+          
+      in return $ MessageFlags (snd <$> filter (\(i',_) -> i .&. i' == i') SigmacordTypeTable)
+
+
+data MessageInteraction = MessageInteraction
+  { messageInteractionId :: InteractionId 
+  , messageInteractionType :: Integer 
+  , messageInteractionName :: T.Text 
+  , messageInteractionUser :: User 
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON MessageInteraction where
+  toJSON MessageInteraction{..} = objectFromMaybes
+              [ "id"   .== messageInteractionId
+              , "type" .== messageInteractionType
+              , "name" .== messageInteractionName
+              , "user" .== messageInteractionUser
+              ]
+
+instance FromJSON MessageInteraction where
+  parseJSON = withObject "MessageInteraction" $ \o ->
+    MessageInteraction <$> o .: "id"
+                       <*> o .: "type"
+                       <*> o .: "name"
+                       <*> o .: "user"

+ src/Sigmacord/Internal/Types/Color.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE DeriveDataTypeable #-}
+
+
+module Sigmacord.Internal.Types.Color where
+
+
+import Text.Read (readMaybe)
+import Data.Maybe (fromMaybe)
+import Data.Char (toLower)
+import Data.Aeson
+import Data.Data
+import Control.Applicative (Alternative((<|>)))
+import Data.Bits (Bits((.&.)))
+
+
+import Sigmacord.Internal.Types.Prelude (InternalSigmacordEnum(..))
+
+
+
+
+
+
+
+data SigmacordColor
+  = 
+    SigmacordColorRGB Integer Integer Integer
+  | SigmacordColorDefault
+  | SigmacordColorAqua
+  | SigmacordColorDarkAqua
+  | SigmacordColorGreen
+  | SigmacordColorDarkGreen
+  | SigmacordColorBlue
+  | SigmacordColorDarkBlue
+  | SigmacordColorPurple
+  | SigmacordColorDarkPurple
+  | SigmacordColorLuminousVividPink
+  | SigmacordColorDarkVividPink
+  | SigmacordColorGold
+  | SigmacordColorDarkGold
+  | SigmacordColorOrange
+  | SigmacordColorDarkOrange
+  | SigmacordColorRed
+  | SigmacordColorDarkRed
+  | SigmacordColorGray
+  | SigmacordColorDarkGray
+  | SigmacordColorDarkerGray
+  | SigmacordColorLightGray
+  | SigmacordColorNavy
+  | SigmacordColorDarkNavy
+  | SigmacordColorYellow
+  | SigmacordColorSigmacordWhite
+  | SigmacordColorSigmacordBlurple
+  | SigmacordColorSigmacordGrayple
+  | SigmacordColorSigmacordDarkButNotBlack
+  | SigmacordColorSigmacordNotQuiteBlack
+  | SigmacordColorSigmacordGreen
+  | SigmacordColorSigmacordYellow
+  | SigmacordColorSigmacordFuschia
+  | SigmacordColorSigmacordRed
+  | SigmacordColorSigmacordBlack
+  deriving (Show, Read, Eq, Ord, Data)
+
+
+
+hexToRGB :: String -> Maybe (Integer, Integer, Integer)
+hexToRGB hex = do
+  let h = map toLower hex
+  r <- take2 h >>= toDec
+  g <- drop2 h >>= take2 >>= toDec
+  b <- drop2 h >>= drop2 >>= toDec
+  return (r, g, b)
+  where
+    take2 (a:b:_) = Just [a, b]
+    take2 _ = Nothing
+    drop2 (_ : _ : as) = Just as
+    drop2 _ = Nothing
+    toDec :: String -> Maybe Integer
+    toDec [s, u] = do
+      a <- charToDec s
+      b <- charToDec u
+      return $ a * 16 + b
+    toDec _ = Nothing
+    charToDec :: Char -> Maybe Integer
+    charToDec 'a' = Just 10
+    charToDec 'b' = Just 11
+    charToDec 'c' = Just 12
+    charToDec 'd' = Just 13
+    charToDec 'e' = Just 14
+    charToDec 'f' = Just 15
+    charToDec c = readMaybe [c]
+
+
+
+hexToSigmacordColor :: String -> SigmacordColor
+hexToSigmacordColor hex =
+  let (r, g, b) = fromMaybe (0, 0, 0) $ hexToRGB hex
+   in SigmacordColorRGB r g b
+
+
+colorToInternal :: SigmacordColor -> Integer
+
+colorToInternal (SigmacordColorRGB r g b) = (r * 256 + g) * 256 + b
+colorToInternal SigmacordColorDefault = 0
+colorToInternal SigmacordColorAqua = 1752220
+colorToInternal SigmacordColorDarkAqua = 1146986
+colorToInternal SigmacordColorGreen = 3066993
+colorToInternal SigmacordColorDarkGreen = 2067276
+colorToInternal SigmacordColorBlue = 3447003
+colorToInternal SigmacordColorDarkBlue = 2123412
+colorToInternal SigmacordColorPurple = 10181046
+colorToInternal SigmacordColorDarkPurple = 7419530
+colorToInternal SigmacordColorLuminousVividPink = 15277667
+colorToInternal SigmacordColorDarkVividPink = 11342935
+colorToInternal SigmacordColorGold = 15844367
+colorToInternal SigmacordColorDarkGold = 12745742
+colorToInternal SigmacordColorOrange = 15105570
+colorToInternal SigmacordColorDarkOrange = 11027200
+colorToInternal SigmacordColorRed = 15158332
+colorToInternal SigmacordColorDarkRed = 10038562
+colorToInternal SigmacordColorGray = 9807270
+colorToInternal SigmacordColorDarkGray = 9936031
+colorToInternal SigmacordColorDarkerGray = 8359053
+colorToInternal SigmacordColorLightGray = 12370112
+colorToInternal SigmacordColorNavy = 3426654
+colorToInternal SigmacordColorDarkNavy = 2899536
+colorToInternal SigmacordColorYellow = 16776960
+colorToInternal SigmacordColorSigmacordWhite = 16777215
+colorToInternal SigmacordColorSigmacordBlurple = 5793266
+colorToInternal SigmacordColorSigmacordGrayple = 10070709
+colorToInternal SigmacordColorSigmacordDarkButNotBlack = 2895667
+colorToInternal SigmacordColorSigmacordNotQuiteBlack = 2303786
+colorToInternal SigmacordColorSigmacordGreen = 5763719
+colorToInternal SigmacordColorSigmacordYellow = 16705372
+colorToInternal SigmacordColorSigmacordFuschia = 15418782
+colorToInternal SigmacordColorSigmacordRed = 15548997
+colorToInternal SigmacordColorSigmacordBlack = 16777215
+
+
+convertToRGB :: Integer -> SigmacordColor
+convertToRGB i = SigmacordColorRGB (div i (256 * 256) .&. 255) (div i 256 .&. 255) (i .&. 255)
+
+instance InternalSigmacordEnum SigmacordColor where
+  SigmacordTypeStartValue = SigmacordColorDefault
+  fromSigmacordType = fromIntegral . colorToInternal
+  SigmacordTypeTable = map (\d -> (fromSigmacordType d, d)) (makeTable SigmacordTypeStartValue)
+    where
+      makeTable :: Data b => b -> [b]
+      makeTable t = map (fromConstrB (fromConstr (toConstr (0 :: Int)))) (dataTypeConstrs $ dataTypeOf t)
+
+instance ToJSON SigmacordColor where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON SigmacordColor where
+  parseJSON =
+    withScientific
+      "SigmacordColor"
+      ( \v ->
+          SigmacordTypeParseJSON "SigmacordColor" (Number v)
+            <|> ( case maybeInt v >>= Just . convertToRGB of
+                    Nothing -> fail $ "could not parse Sigmacord color: " ++ show v
+                    Just d -> return d
+                )
+      )
+    where
+      maybeInt i
+        | fromIntegral (round i) == i = Just $ round i
+        | otherwise = Nothing

+ src/Sigmacord/Internal/Types/Components.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+
+module Sigmacord.Internal.Types.Components
+  ( ActionRow (..),
+    Button (..),
+    ButtonStyle (..),
+    mkButton,
+    SelectMenu (..),
+    mkSelectMenu,
+    SelectMenuData (..),
+    SelectOption (..),
+    mkSelectOption,
+    TextInput (..),
+    mkTextInput,
+  )
+where
+
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.Foldable (Foldable (toList))
+import Data.Scientific (Scientific)
+import qualified Data.Text as T
+import Sigmacord.Internal.Types.Emoji (Emoji)
+import Sigmacord.Internal.Types.Prelude (objectFromMaybes, (.==), (.=?), ChannelTypeOption)
+
+
+data ActionRow = ActionRowButtons [Button] | ActionRowSelectMenu SelectMenu
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ActionRow where
+  parseJSON =
+    withObject
+      "ActionRow"
+      ( \cs -> do
+          t <- cs .: "type" :: Parser Int
+          case t of
+            1 -> do
+              a <- cs .: "components" :: Parser Array
+              let a' = toList a
+              case a' of
+                [] -> return $ ActionRowButtons []
+                (c : _) ->
+                  withObject
+                    "ActionRow item"
+                    ( \v -> do
+                        t' <- v .: "type" :: Parser Int
+                        case t' of
+                          2 -> ActionRowButtons <$> mapM parseJSON a'
+                          _ | t' `elem` [3, 5, 6, 7, 8] -> ActionRowSelectMenu <$> parseJSON c
+                          _ -> fail $ "unknown component type: " ++ show t'
+                    )
+                    c
+            _ -> fail $ "expected action row type (1), got: " ++ show t
+      )
+
+instance ToJSON ActionRow where
+  toJSON (ActionRowButtons bs) = object [("type", Number 1), ("components", toJSON bs)]
+  toJSON (ActionRowSelectMenu bs) = object [("type", Number 1), ("components", toJSON [bs])]
+
+
+
+
+data Button
+  = Button
+      { 
+        buttonCustomId :: T.Text,
+        
+        buttonDisabled :: Bool,
+        
+        buttonStyle :: ButtonStyle,
+        
+        buttonLabel :: Maybe T.Text,
+        
+        buttonEmoji :: Maybe Emoji
+      }
+  | ButtonUrl
+      { 
+        
+        buttonUrl :: T.Text,
+        
+        buttonDisabled :: Bool,
+        
+        buttonLabel :: Maybe T.Text,
+        
+        buttonEmoji :: Maybe Emoji
+      }
+  deriving (Show, Read, Eq, Ord)
+
+
+mkButton :: T.Text -> T.Text -> Button
+mkButton label customId = Button customId False ButtonStyleSecondary (Just label) Nothing
+
+instance FromJSON Button where
+  parseJSON =
+    withObject
+      "Button"
+      ( \v -> do
+          t <- v .: "type" :: Parser Int
+          case t of
+            2 -> do
+              disabled <- v .:? "disabled" .!= False
+              label <- v .:? "label"
+              partialEmoji <- v .:? "emoji"
+              style <- v .: "style" :: Parser Scientific
+              case style of
+                5 ->
+                  ButtonUrl
+                    <$> v .: "url"
+                    <*> return disabled
+                    <*> return label
+                    <*> return partialEmoji
+                _ ->
+                  Button
+                    <$> v .: "custom_id"
+                    <*> return disabled
+                    <*> parseJSON (Number style)
+                    <*> return label
+                    <*> return partialEmoji
+            _ -> fail "expected button type, got a different component"
+      )
+
+instance ToJSON Button where
+  toJSON ButtonUrl {..} =
+    objectFromMaybes
+      [ "type" .== Number 2,
+        "style" .== Number 5,
+        "label" .=? buttonLabel,
+        "disabled" .== buttonDisabled,
+        "url" .== buttonUrl,
+        "emoji" .=? buttonEmoji
+      ]
+  toJSON Button {..} =
+    objectFromMaybes
+      [ "type" .== Number 2,
+        "style" .== buttonStyle,
+        "label" .=? buttonLabel,
+        "disabled" .== buttonDisabled,
+        "custom_id" .== buttonCustomId,
+        "emoji" .=? buttonEmoji
+      ]
+
+
+data ButtonStyle
+  = 
+    ButtonStylePrimary
+  | 
+    ButtonStyleSecondary
+  | 
+    ButtonStyleSuccess
+  | 
+    ButtonStyleDanger
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ButtonStyle where
+  parseJSON =
+    withScientific
+      "ButtonStyle"
+      ( \case
+          1 -> return ButtonStylePrimary
+          2 -> return ButtonStyleSecondary
+          3 -> return ButtonStyleSuccess
+          4 -> return ButtonStyleDanger
+          _ -> fail "unrecognised non-url button style"
+      )
+
+instance ToJSON ButtonStyle where
+  toJSON ButtonStylePrimary = Number 1
+  toJSON ButtonStyleSecondary = Number 2
+  toJSON ButtonStyleSuccess = Number 3
+  toJSON ButtonStyleDanger = Number 4
+
+
+
+
+data SelectMenu = SelectMenu
+  { 
+    selectMenuCustomId :: T.Text,
+    
+    selectMenuDisabled :: Bool,
+    
+    selectMenuData :: SelectMenuData,
+    
+    selectMenuPlaceholder :: Maybe T.Text,
+    
+    selectMenuMinValues :: Maybe Integer,
+    
+    selectMenuMaxValues :: Maybe Integer
+  }
+  deriving (Show, Read, Eq, Ord)
+
+
+
+mkSelectMenu :: T.Text -> [SelectOption] -> SelectMenu
+mkSelectMenu customId sos = SelectMenu customId False (SelectMenuDataText sos) Nothing Nothing Nothing
+
+instance FromJSON SelectMenu where
+  parseJSON =
+    withObject
+      "SelectMenu"
+      $ \v ->
+          do
+                SelectMenu
+                  <$> v .: "custom_id"
+                  <*> v .:? "disabled" .!= False
+                  <*> parseJSON (Object v)
+                  <*> v .:? "placeholder"
+                  <*> v .:? "min_values"
+                  <*> v .:? "max_values"
+      
+
+instance ToJSON SelectMenu where
+  toJSON SelectMenu {..} =
+    objectFromMaybes $
+      [ "custom_id" .== selectMenuCustomId,
+        "disabled" .== selectMenuDisabled,
+        "placeholder" .=? selectMenuPlaceholder,
+        "min_values" .=? selectMenuMinValues,
+        "max_values" .=? selectMenuMaxValues
+      ] <> case selectMenuData of
+            SelectMenuDataText sos -> ["type" .== Number 3, "options" .== sos]
+            SelectMenuDataUser -> ["type" .== Number 5]
+            SelectMenuDataRole -> ["type" .== Number 6]
+            SelectMenuDataMentionable -> ["type" .== Number 7]
+            SelectMenuDataChannels ctos -> ["type" .== Number 8, "channel_types" .== ctos]
+
+data SelectMenuData = 
+    SelectMenuDataText [SelectOption] 
+  | SelectMenuDataUser 
+  | SelectMenuDataRole 
+  | SelectMenuDataMentionable 
+  | SelectMenuDataChannels [ChannelTypeOption] 
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON SelectMenuData where
+  parseJSON =
+    withObject "SelectMenuData" $ \v ->
+      do
+        t <- v .: "type"
+        case t::Int of
+          3 -> SelectMenuDataText <$> v .: "options"
+          5 -> pure SelectMenuDataUser
+          6 -> pure SelectMenuDataRole
+          7 -> pure SelectMenuDataMentionable
+          8 -> SelectMenuDataChannels <$> v .: "channel_types"
+          _ -> fail ("unknown select menu data type: " <> show t)
+
+
+data SelectOption = SelectOption
+  { 
+    selectOptionLabel :: T.Text,
+    
+    selectOptionValue :: T.Text,
+    
+    selectOptionDescription :: Maybe T.Text,
+    
+    selectOptionEmoji :: Maybe Emoji,
+    
+    selectOptionDefault :: Maybe Bool
+  }
+  deriving (Show, Read, Eq, Ord)
+
+
+mkSelectOption :: T.Text -> T.Text -> SelectOption
+mkSelectOption label value = SelectOption label value Nothing Nothing Nothing
+
+instance FromJSON SelectOption where
+  parseJSON = withObject "SelectOption" $ \o ->
+    SelectOption <$> o .: "label"
+      <*> o .: "value"
+      <*> o .:? "description"
+      <*> o .:? "emoji"
+      <*> o .:? "default"
+
+instance ToJSON SelectOption where
+  toJSON SelectOption {..} =
+    objectFromMaybes
+      [ "label" .== selectOptionLabel,
+        "value" .== selectOptionValue,
+        "description" .=? selectOptionDescription,
+        "emoji" .=? selectOptionEmoji,
+        "default" .=? selectOptionDefault
+      ]
+
+data TextInput = TextInput
+  { 
+    textInputCustomId :: T.Text,
+    
+    textInputIsParagraph :: Bool,
+    
+    textInputLabel :: T.Text,
+    
+    textInputMinLength :: Maybe Integer,
+    
+    textInputMaxLength :: Maybe Integer,
+    
+    textInputRequired :: Bool,
+    
+    textInputValue :: T.Text,
+    
+    textInputPlaceholder :: T.Text
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON TextInput where
+  toJSON TextInput {..} =
+    objectFromMaybes
+      [ "type" .== Number 4,
+        "custom_id" .== textInputCustomId,
+        "style" .== (1 + fromEnum textInputIsParagraph),
+        "label" .== textInputLabel,
+        "min_length" .=? textInputMinLength,
+        "max_length" .=? textInputMaxLength,
+        "required" .== textInputRequired,
+        "value" .== textInputValue,
+        "placeholder" .== textInputPlaceholder
+      ]
+
+instance FromJSON TextInput where
+  parseJSON = withObject "TextInput" $ \o -> do
+    t <- o .: "type" :: Parser Int
+    case t of
+      4 ->
+        TextInput <$> o .: "custom_id"
+          <*> fmap (== (2 :: Int)) (o .:? "style" .!= 1)
+          <*> o .:? "label" .!= ""
+          <*> o .:? "min_length"
+          <*> o .:? "max_length"
+          <*> o .:? "required" .!= False
+          <*> o .:? "value" .!= ""
+          <*> o .:? "placeholder" .!= ""
+      _ -> fail "expected text input, found other type of component"
+
+
+mkTextInput :: T.Text -> T.Text -> TextInput
+mkTextInput cid label = TextInput cid False label Nothing Nothing True "" ""

+ src/Sigmacord/Internal/Types/Embed.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RecordWildCards #-}
+
+
+module Sigmacord.Internal.Types.Embed where
+
+import Data.Aeson
+import Data.Time.Clock
+import Data.Default (Default, def)
+import qualified Data.Text as T
+import qualified Data.ByteString as B
+import Data.Functor ((<&>))
+
+import Network.HTTP.Client.MultipartFormData (PartM, partFileRequestBody)
+import Network.HTTP.Client (RequestBody(RequestBodyBS))
+
+import Sigmacord.Internal.Types.Color (SigmacordColor)
+
+createEmbed :: CreateEmbed -> Embed
+createEmbed CreateEmbed{..} =
+  let
+    emptyMaybe :: T.Text -> Maybe T.Text
+    emptyMaybe t = if T.null t then Nothing else Just t
+
+    embedImageToUrl :: T.Text -> CreateEmbedImage -> T.Text
+    embedImageToUrl place cei = case cei of
+                            CreateEmbedImageUrl t -> t
+                            CreateEmbedImageUpload _ -> T.filter (/=' ') $ "attachment://" <> createEmbedTitle <> place <> ".png"
+
+    embedAuthor = EmbedAuthor createEmbedAuthorName
+                              (emptyMaybe createEmbedAuthorUrl)
+                              (embedImageToUrl "author" <$> createEmbedAuthorIcon)
+                              Nothing
+    embedImage = (embedImageToUrl "image" <$> createEmbedImage) <&>
+                  \image -> EmbedImage image Nothing Nothing Nothing
+    embedThumbnail = (embedImageToUrl "thumbnail" <$> createEmbedThumbnail) <&>
+                      \thumbnail -> EmbedThumbnail thumbnail Nothing Nothing Nothing
+    embedFooter = EmbedFooter createEmbedFooterText
+                              (embedImageToUrl "footer" <$> createEmbedFooterIcon)
+                              Nothing
+
+  in Embed { embedAuthor      = Just embedAuthor
+           , embedTitle       = emptyMaybe createEmbedTitle
+           , embedUrl         = emptyMaybe createEmbedUrl
+           , embedThumbnail   = embedThumbnail
+           , embedDescription = emptyMaybe createEmbedDescription
+           , embedFields      = createEmbedFields
+           , embedImage       = embedImage
+           , embedFooter      = Just embedFooter
+           , embedColor       = createEmbedColor
+           , embedTimestamp   = createEmbedTimestamp
+
+           
+           , embedVideo       = Nothing
+           , embedProvider    = Nothing
+           }
+
+data CreateEmbed = CreateEmbed
+  { createEmbedAuthorName  :: T.Text
+  , createEmbedAuthorUrl   :: T.Text
+  , createEmbedAuthorIcon  :: Maybe CreateEmbedImage
+  , createEmbedTitle       :: T.Text
+  , createEmbedUrl         :: T.Text
+  , createEmbedThumbnail   :: Maybe CreateEmbedImage
+  , createEmbedDescription :: T.Text
+  , createEmbedFields      :: [EmbedField]
+  , createEmbedImage       :: Maybe CreateEmbedImage
+  , createEmbedFooterText  :: T.Text
+  , createEmbedFooterIcon  :: Maybe CreateEmbedImage
+  , createEmbedColor       :: Maybe SigmacordColor
+  , createEmbedTimestamp   :: Maybe UTCTime
+  } deriving (Show, Read, Eq, Ord)
+
+data CreateEmbedImage = CreateEmbedImageUrl T.Text
+                      | CreateEmbedImageUpload B.ByteString
+  deriving (Show, Read, Eq, Ord)
+
+instance Default CreateEmbed where
+ def = CreateEmbed "" "" Nothing "" "" Nothing "" [] Nothing "" Nothing Nothing Nothing
+
+
+data Embed = Embed
+  { embedAuthor      :: Maybe EmbedAuthor
+  , embedTitle       :: Maybe T.Text     
+  , embedUrl         :: Maybe T.Text     
+  , embedThumbnail   :: Maybe EmbedThumbnail 
+  , embedDescription :: Maybe T.Text     
+  , embedFields      :: [EmbedField]     
+  , embedImage       :: Maybe EmbedImage
+  , embedFooter      :: Maybe EmbedFooter
+  , embedColor       :: Maybe SigmacordColor    
+  , embedTimestamp   :: Maybe UTCTime    
+  , embedVideo       :: Maybe EmbedVideo 
+  , embedProvider    :: Maybe EmbedProvider 
+  } deriving (Show, Read, Eq, Ord)
+
+
+instance ToJSON Embed where
+  toJSON Embed{..} = object
+   [ "author"      .= embedAuthor
+   , "title"       .= embedTitle
+   , "url"         .= embedUrl
+   , "description" .= embedDescription
+   , "thumbnail"   .= embedThumbnail
+   , "fields"      .= embedFields
+   , "image"       .= embedImage
+   , "footer"      .= embedFooter
+   , "color"       .= embedColor
+   , "timestamp"   .= embedTimestamp
+   , "video"       .= embedVideo
+   , "provider"    .= embedProvider
+    ]
+
+instance FromJSON Embed where
+  parseJSON = withObject "embed" $ \o ->
+    Embed <$> o .:? "author"
+          <*> o .:? "title"
+          <*> o .:? "url"
+          <*> o .:? "thumbnail"
+          <*> o .:? "description"
+          <*> o .:? "fields" .!= []
+          <*> o .:? "image"
+          <*> o .:? "footer"
+          <*> o .:? "color"
+          <*> o .:? "timestamp"
+          <*> o .:? "video"
+          <*> o .:? "provider"
+
+
+data EmbedThumbnail = EmbedThumbnail
+  { embedThumbnailUrl :: T.Text
+  , embedThumbnailProxyUrl :: Maybe T.Text
+  , embedThumbnailHeight :: Maybe Integer
+  , embedThumbnailWidth :: Maybe Integer
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedThumbnail where
+  toJSON (EmbedThumbnail a b c d) = object
+    [ "url" .= a
+    , "proxy_url" .= b
+    , "height" .= c
+    , "width" .= d
+    ]
+
+instance FromJSON EmbedThumbnail where
+  parseJSON = withObject "thumbnail" $ \o ->
+    EmbedThumbnail <$> o .: "url"
+                   <*> o .:? "proxy_url"
+                   <*> o .:? "height"
+                   <*> o .:? "width"
+
+data EmbedVideo = EmbedVideo
+  { embedVideoUrl :: Maybe T.Text
+  , embedProxyUrl :: Maybe T.Text
+  , embedVideoHeight :: Maybe Integer
+  , embedVideoWidth :: Maybe Integer
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedVideo where
+  toJSON (EmbedVideo a a' b c) = object
+    [ "url" .= a
+    , "height" .= b
+    , "width" .= c
+    , "proxy_url" .= a'
+    ]
+
+instance FromJSON EmbedVideo where
+  parseJSON = withObject "video" $ \o ->
+    EmbedVideo <$> o .:? "url"
+               <*> o .:? "proxy_url"
+               <*> o .:? "height"
+               <*> o .:? "width"
+
+data EmbedImage = EmbedImage
+  { embedImageUrl :: T.Text
+  , embedImageProxyUrl :: Maybe T.Text
+  , embedImageHeight :: Maybe Integer
+  , embedImageWidth :: Maybe Integer
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedImage where
+  toJSON (EmbedImage a b c d) = object
+    [ "url" .= a
+    , "proxy_url" .= b
+    , "height" .= c
+    , "width" .= d
+    ]
+
+instance FromJSON EmbedImage where
+  parseJSON = withObject "image" $ \o ->
+    EmbedImage <$> o .:  "url"
+               <*> o .:? "proxy_url"
+               <*> o .:? "height"
+               <*> o .:? "width"
+
+data EmbedProvider = EmbedProvider
+  { embedProviderName :: Maybe T.Text
+  , embedProviderUrl :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedProvider where
+  toJSON (EmbedProvider a b) = object
+    [ "name" .= a
+    , "url" .= b
+    ]
+
+instance FromJSON EmbedProvider where
+  parseJSON = withObject "provider" $ \o ->
+    EmbedProvider <$> o .:? "name"
+                  <*> o .:? "url"
+
+data EmbedAuthor = EmbedAuthor
+  { embedAuthorName :: T.Text
+  , embedAuthorUrl :: Maybe T.Text
+  , embedAuthorIconUrl :: Maybe T.Text
+  , embedAuthorProxyIconUrl :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedAuthor where
+  toJSON (EmbedAuthor a b c d) = object
+    [ "name" .= a
+    , "url" .= b
+    , "icon_url" .= c
+    , "proxy_icon_url" .= d
+    ]
+
+instance FromJSON EmbedAuthor where
+  parseJSON = withObject "author" $ \o ->
+    EmbedAuthor <$> o .:  "name"
+                <*> o .:? "url"
+                <*> o .:? "icon_url"
+                <*> o .:? "proxy_icon_url"
+
+data EmbedFooter = EmbedFooter
+  { embedFooterText :: T.Text
+  , embedFooterIconUrl :: Maybe T.Text
+  , embedFooterProxyIconUrl :: Maybe T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedFooter where
+  toJSON (EmbedFooter a b c) = object
+    [ "text" .= a
+    , "icon_url" .= b
+    , "proxy_icon_url" .= c
+    ]
+
+instance FromJSON EmbedFooter where
+  parseJSON = withObject "footer" $ \o ->
+    EmbedFooter <$> o .:  "text"
+                <*> o .:? "icon_url"
+                <*> o .:? "proxy_icon_url"
+
+data EmbedField = EmbedField
+  { embedFieldName :: T.Text
+  , embedFieldValue :: T.Text
+  , embedFieldInline :: Maybe Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance ToJSON EmbedField where
+  toJSON (EmbedField a b c) = object
+    [ "name" .= a
+    , "value" .= b
+    , "inline" .= c
+    ]
+
+instance FromJSON EmbedField where
+  parseJSON = withObject "field" $ \o ->
+    EmbedField <$> o .:  "name"
+               <*> o .:  "value"
+               <*> o .:? "inline"
+
+
+maybeEmbed :: Maybe CreateEmbed -> [PartM IO]
+maybeEmbed =
+      let mkPart (name,content) = partFileRequestBody name (T.unpack name) (RequestBodyBS content)
+          uploads CreateEmbed{..} = [(T.filter (/=' ') $ createEmbedTitle<>n,c) | (n, Just (CreateEmbedImageUpload c)) <-
+                                          [ ("author.png", createEmbedAuthorIcon)
+                                          , ("thumbnail.png", createEmbedThumbnail)
+                                          , ("image.png", createEmbedImage)
+                                          , ("footer.png", createEmbedFooterIcon) ]]
+      in maybe [] (map mkPart . uploads)

+ src/Sigmacord/Internal/Types/Emoji.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Sigmacord.Internal.Types.Emoji where
+
+import Data.Aeson
+import Data.Data
+import Data.Functor ((<&>))
+import Data.Text as T
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.User
+
+
+data Emoji = Emoji
+  { 
+    emojiId :: Maybe EmojiId,
+    
+    emojiName :: T.Text,
+    
+    emojiRoles :: Maybe [RoleId],
+    
+    emojiUser :: Maybe User,
+    
+    emojiManaged :: Maybe Bool,
+    
+    emojiAnimated :: Maybe Bool
+  }
+  deriving (Show, Read, Eq, Ord)
+
+
+mkEmoji :: T.Text -> Emoji
+mkEmoji t = Emoji Nothing t Nothing Nothing Nothing Nothing
+
+instance FromJSON Emoji where
+  parseJSON = withObject "Emoji" $ \o ->
+    Emoji <$> o .:? "id"
+      <*> o .: "name"
+      <*> o .:? "roles"
+      <*> o .:? "user"
+      <*> o .:? "managed"
+      <*> o .:? "animated"
+
+instance ToJSON Emoji where
+  toJSON Emoji {..} =
+    objectFromMaybes
+            [ "id" .=? emojiId,
+              "name" .== emojiName,
+              "roles" .=? emojiRoles,
+              "user" .=? emojiUser,
+              "managed" .=? emojiManaged,
+              "animated" .=? emojiAnimated
+            ]
+
+
+data StickerPack = StickerPack
+  { 
+    stickerPackId :: Snowflake,
+    
+    stickerPackStickers :: [Sticker],
+    
+    stickerPackName :: T.Text,
+    
+    stickerPackSKUId :: Snowflake,
+    
+    stickerPackCoverStickerId :: Maybe StickerId,
+    
+    stickerPackDescription :: T.Text,
+    
+    stickerPackBannerAssetId :: Maybe Snowflake
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON StickerPack where
+  parseJSON = withObject "StickerPack" $ \o ->
+    StickerPack <$> o .: "id"
+      <*> o .: "stickers"
+      <*> o .: "name"
+      <*> o .: "sku_id"
+      <*> o .:? "cover_sticker_id"
+      <*> o .: "description"
+      <*> o .:? "banner_asset_id"
+
+
+data Sticker = Sticker
+  { 
+    stickerId :: StickerId,
+    
+    stickerStickerPackId :: Maybe Snowflake,
+    
+    stickerName :: T.Text,
+    
+    stickerDescription :: Maybe T.Text,
+    
+    stickerTags :: [T.Text],
+    
+    stickerIsStandardType :: Bool,
+    
+    stickerFormatType :: StickerFormatType,
+    
+    stickerAvailable :: Maybe Bool,
+    
+    stickerGuildId :: Maybe GuildId,
+    
+    stickerUser :: Maybe User,
+    
+    stickerSortValue :: Maybe Integer
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Sticker where
+  parseJSON = withObject "Sticker" $ \o ->
+    Sticker <$> o .: "id"
+      <*> o .:? "pack_id"
+      <*> o .:  "name"
+      <*> o .:? "description"
+      <*> ((o .: "tags") <&> T.splitOn "\n")
+      <*> ((o .: "type") <&> (== (1 :: Int)))
+      <*> o .: "format_type"
+      <*> o .:? "available"
+      <*> o .:? "guild_id"
+      <*> o .:? "user"
+      <*> o .:? "sort_value"
+
+
+data StickerItem = StickerItem
+  { 
+    stickerItemId :: StickerId,
+    
+    stickerItemName :: T.Text,
+    
+    stickerItemFormatType :: StickerFormatType
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON StickerItem where
+  parseJSON = withObject "StickerItem" $ \o ->
+    StickerItem <$> o .: "id"
+      <*> o .: "name"
+      <*> o .: "format_type"
+
+instance ToJSON StickerItem where
+  toJSON StickerItem {..} =
+    object
+      [ ("id", toJSON stickerItemId),
+        ("name", toJSON stickerItemName),
+        ("format_type", toJSON stickerItemFormatType)
+      ]
+
+
+data StickerFormatType
+  = StickerFormatTypePNG
+  | StickerFormatTypeAPNG
+  | StickerFormatTypeLOTTIE
+  deriving (Show, Read, Eq, Ord, Data)
+
+instance InternalSigmacordEnum StickerFormatType where
+  SigmacordTypeStartValue = StickerFormatTypePNG
+  fromSigmacordType StickerFormatTypePNG = 1
+  fromSigmacordType StickerFormatTypeAPNG = 2
+  fromSigmacordType StickerFormatTypeLOTTIE = 3
+
+instance ToJSON StickerFormatType where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON StickerFormatType where
+  parseJSON = SigmacordTypeParseJSON "StickerFormatType"

+ src/Sigmacord/Internal/Types/Events.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Sigmacord.Internal.Types.Events where
+
+import Prelude hiding (id)
+
+import Data.Time.ISO8601 (parseISO8601)
+import Data.Time (UTCTime)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Network.Socket (HostName)
+
+import Data.Aeson
+import Data.Aeson.Types
+import qualified Data.Text as T
+
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.Channel
+import Sigmacord.Internal.Types.Guild
+import Sigmacord.Internal.Types.User (User, GuildMember)
+import Sigmacord.Internal.Types.Interactions (Interaction)
+import Sigmacord.Internal.Types.Emoji (Emoji)
+import Sigmacord.Internal.Types.ScheduledEvents (ScheduledEvent)
+
+
+
+data Event =
+  
+    Ready                      Int User [GuildUnavailable] T.Text HostName (Maybe Shard) PartialApplication
+  
+  | Resumed                    [T.Text]
+  
+  | ChannelCreate              Channel
+  
+  | ChannelUpdate              Channel
+  
+  | ChannelDelete              Channel
+  
+  | ThreadCreate               Channel
+  
+  | ThreadUpdate               Channel
+  
+  | ThreadDelete               Channel
+  
+  | ThreadListSync             ThreadListSyncFields
+  
+  | ThreadMembersUpdate        ThreadMembersUpdateFields
+  
+  | ChannelPinsUpdate          ChannelId (Maybe UTCTime)
+  
+  | GuildCreate                Guild GuildCreateData
+  
+  | GuildUpdate                Guild
+  
+  | GuildDelete                GuildUnavailable
+  
+  | GuildBanAdd                GuildId User
+  
+  | GuildBanRemove             GuildId User
+  
+  | GuildEmojiUpdate           GuildId [Emoji]
+  
+  | GuildIntegrationsUpdate    GuildId
+  
+  | GuildMemberAdd             GuildId GuildMember
+  
+  | GuildMemberRemove          GuildId User
+  
+  | GuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)
+  
+  | GuildMemberChunk           GuildId [GuildMember]
+  
+  | GuildRoleCreate            GuildId Role
+  
+  | GuildRoleUpdate            GuildId Role
+  
+  | GuildRoleDelete            GuildId RoleId
+  
+  | MessageCreate              Message
+  
+  | MessageUpdate              ChannelId MessageId
+  
+  | MessageDelete              ChannelId MessageId
+  
+  | MessageDeleteBulk          ChannelId [MessageId]
+  
+  | MessageReactionAdd         ReactionInfo
+  
+  | MessageReactionRemove      ReactionInfo
+  
+  | MessageReactionRemoveAll   ChannelId MessageId
+  
+  | MessageReactionRemoveEmoji ReactionRemoveInfo
+  
+  | PresenceUpdate             PresenceInfo
+  
+  | TypingStart                TypingInfo
+  
+  | UserUpdate                 User
+  
+  | InteractionCreate          Interaction
+  
+  
+  
+  | UnknownEvent               T.Text Object
+  deriving (Show, Eq)
+
+
+
+
+data EventInternalParse =
+    InternalReady                      Int User [GuildUnavailable] T.Text HostName (Maybe Shard) PartialApplication
+  | InternalResumed                    [T.Text]
+  | InternalChannelCreate              Channel
+  | InternalChannelUpdate              Channel
+  | InternalChannelDelete              Channel
+  | InternalThreadCreate               Channel
+  | InternalThreadUpdate               Channel
+  | InternalThreadDelete               Channel
+  | InternalThreadListSync             ThreadListSyncFields 
+  | InternalThreadMembersUpdate        ThreadMembersUpdateFields 
+  | InternalChannelPinsUpdate          ChannelId (Maybe UTCTime)
+  | InternalGuildCreate                Guild GuildCreateData
+  | InternalGuildUpdate                Guild
+  | InternalGuildDelete                GuildUnavailable
+  | InternalGuildBanAdd                GuildId User
+  | InternalGuildBanRemove             GuildId User
+  | InternalGuildEmojiUpdate           GuildId [Emoji]
+  | InternalGuildIntegrationsUpdate    GuildId
+  | InternalGuildMemberAdd             GuildId GuildMember
+  | InternalGuildMemberRemove          GuildId User
+  | InternalGuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)
+  | InternalGuildMemberChunk           GuildId [GuildMember]
+  | InternalGuildRoleCreate            GuildId Role
+  | InternalGuildRoleUpdate            GuildId Role
+  | InternalGuildRoleDelete            GuildId RoleId
+  | InternalMessageCreate              Message
+  | InternalMessageUpdate              ChannelId MessageId
+  | InternalMessageDelete              ChannelId MessageId
+  | InternalMessageDeleteBulk          ChannelId [MessageId]
+  | InternalMessageReactionAdd         ReactionInfo
+  | InternalMessageReactionRemove      ReactionInfo
+  | InternalMessageReactionRemoveAll   ChannelId MessageId
+  | InternalMessageReactionRemoveEmoji ReactionRemoveInfo
+  | InternalPresenceUpdate             PresenceInfo
+  | InternalTypingStart                TypingInfo
+  | InternalUserUpdate                 User
+  | InternalInteractionCreate          Interaction
+  
+  
+  | InternalUnknownEvent               T.Text Object
+  deriving (Show, Eq, Read)
+
+
+data PartialApplication = PartialApplication
+  { partialApplicationID :: ApplicationId
+  , partialApplicationFlags :: Int
+  } deriving (Show, Eq, Read)
+
+instance FromJSON PartialApplication where
+  parseJSON = withObject "PartialApplication" (\v -> PartialApplication <$> v .: "id" <*> v .: "flags")
+
+data GuildCreateData = GuildCreateData
+  { guildCreateJoinedAt :: !UTCTime
+  , guildCreateLarge :: !Bool
+  , guildCreateUnavailable :: !(Maybe Bool)
+  , guildCreateMemberCount :: !Int
+  
+  , guildCreateMembers :: ![GuildMember]
+  , guildCreateChannels :: ![Channel]
+  , guildCreateThreads :: ![Channel]
+  , guildCreatePresences :: ![PresenceInfo]
+  
+  , guildCreateScheduledEvents :: ![ScheduledEvent]
+  } deriving (Show, Eq, Read)
+
+instance FromJSON GuildCreateData where
+  parseJSON = withObject "GuildCreateData" $ \o ->
+    GuildCreateData <$> o .:  "joined_at"
+                    <*> o .:  "large"
+                    <*> o .:? "unavailable"
+                    <*> o .:  "member_count"
+                    <*> o .:  "members"
+                    <*> o .:  "channels"
+                    <*> o .:  "threads"
+                    <*> o .:  "presences"
+                    <*> o .:  "guild_scheduled_events"
+
+
+data ReactionInfo = ReactionInfo
+  { reactionUserId    :: UserId 
+  , reactionGuildId   :: Maybe GuildId 
+  , reactionChannelId :: ChannelId 
+  , reactionMessageId :: MessageId 
+  , reactionEmoji     :: Emoji 
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ReactionInfo where
+  parseJSON = withObject "ReactionInfo" $ \o ->
+    ReactionInfo <$> o .:  "user_id"
+                 <*> o .:? "guild_id"
+                 <*> o .:  "channel_id"
+                 <*> o .:  "message_id"
+                 <*> o .:  "emoji"
+
+
+data ReactionRemoveInfo  = ReactionRemoveInfo
+  { reactionRemoveChannelId :: ChannelId
+  , reactionRemoveGuildId   :: GuildId
+  , reactionRemoveMessageId :: MessageId
+  , reactionRemoveEmoji     :: Emoji
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ReactionRemoveInfo where
+  parseJSON = withObject "ReactionRemoveInfo" $ \o ->
+    ReactionRemoveInfo <$> o .:  "guild_id"
+                       <*> o .:  "channel_id"
+                       <*> o .:  "message_id"
+                       <*> o .:  "emoji"
+
+
+data TypingInfo = TypingInfo
+  { typingUserId    :: UserId
+  , typingChannelId :: ChannelId
+  , typingTimestamp :: UTCTime
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON TypingInfo where
+  parseJSON = withObject "TypingInfo" $ \o ->
+    do cid <- o .: "channel_id"
+       uid <- o .: "user_id"
+       posix <- o .: "timestamp"
+       let utc = posixSecondsToUTCTime posix
+       pure (TypingInfo uid cid utc)
+
+
+
+
+reparse :: (ToJSON a, FromJSON b) => a -> Parser b
+reparse val = case parseEither parseJSON $ toJSON val of
+                Left r -> fail r
+                Right b -> pure b
+
+
+
+extractHostname :: String -> HostName
+extractHostname ('w':'s':'s':':':'/':'/':rest) = extractHostname rest
+extractHostname "/" = []
+extractHostname (a:b) = a:extractHostname b
+extractHostname [] = []
+
+
+eventParse :: T.Text -> Object -> Parser EventInternalParse
+eventParse t o = case t of
+    "READY"                     -> InternalReady <$> o .: "v"
+                                         <*> o .: "user"
+                                         <*> o .: "guilds"
+                                         <*> o .: "session_id"
+                                          
+                                          
+                                          
+                                         <*> (extractHostname <$> o .: "resume_gateway_url")
+                                         <*> o .: "shard"
+                                         <*> o .: "application"
+    "RESUMED"                   -> InternalResumed <$> o .: "_trace"
+    "CHANNEL_CREATE"            -> InternalChannelCreate             <$> reparse o
+    "CHANNEL_UPDATE"            -> InternalChannelUpdate             <$> reparse o
+    "CHANNEL_DELETE"            -> InternalChannelDelete             <$> reparse o
+    "THREAD_CREATE"             -> InternalThreadCreate              <$> reparse o
+    "THREAD_UPDATE"             -> InternalThreadUpdate              <$> reparse o
+    "THREAD_DELETE"             -> InternalThreadDelete              <$> reparse o
+    "THREAD_LIST_SYNC"          -> InternalThreadListSync            <$> reparse o
+    "THREAD_MEMBERS_UPDATE"     -> InternalThreadMembersUpdate       <$> reparse o
+    "CHANNEL_PINS_UPDATE"       -> do id <- o .: "channel_id"
+                                      stamp <- o .:? "last_pin_timestamp"
+                                      let utc = stamp >>= parseISO8601
+                                      pure (InternalChannelPinsUpdate id utc)
+    "GUILD_CREATE"              -> InternalGuildCreate <$> reparse o <*> reparse o
+    "GUILD_UPDATE"              -> InternalGuildUpdate               <$> reparse o
+    "GUILD_DELETE"              -> InternalGuildDelete               <$> reparse o
+    "GUILD_BAN_ADD"             -> InternalGuildBanAdd    <$> o .: "guild_id" <*> o .: "user"
+    "GUILD_BAN_REMOVE"          -> InternalGuildBanRemove <$> o .: "guild_id" <*> o .: "user"
+    "GUILD_EMOJI_UPDATE"        -> InternalGuildEmojiUpdate <$> o .: "guild_id" <*> o .: "emojis"
+    "GUILD_INTEGRATIONS_UPDATE" -> InternalGuildIntegrationsUpdate   <$> o .: "guild_id"
+    "GUILD_MEMBER_ADD"          -> InternalGuildMemberAdd <$> o .: "guild_id" <*> reparse o
+    "GUILD_MEMBER_REMOVE"       -> InternalGuildMemberRemove <$> o .: "guild_id" <*> o .: "user"
+    "GUILD_MEMBER_UPDATE"       -> InternalGuildMemberUpdate <$> o .: "guild_id"
+                                                             <*> o .: "roles"
+                                                             <*> o .: "user"
+                                                             <*> o .:? "nick"
+    "GUILD_MEMBERS_CHUNK"       -> InternalGuildMemberChunk <$> o .: "guild_id" <*> o .: "members"
+    "GUILD_ROLE_CREATE"         -> InternalGuildRoleCreate  <$> o .: "guild_id" <*> o .: "role"
+    "GUILD_ROLE_UPDATE"         -> InternalGuildRoleUpdate  <$> o .: "guild_id" <*> o .: "role"
+    "GUILD_ROLE_DELETE"         -> InternalGuildRoleDelete  <$> o .: "guild_id" <*> o .: "role_id"
+    "MESSAGE_CREATE"            -> InternalMessageCreate     <$> reparse o
+    "MESSAGE_UPDATE"            -> InternalMessageUpdate     <$> o .: "channel_id" <*> o .: "id"
+    "MESSAGE_DELETE"            -> InternalMessageDelete     <$> o .: "channel_id" <*> o .: "id"
+    "MESSAGE_DELETE_BULK"       -> InternalMessageDeleteBulk <$> o .: "channel_id" <*> o .: "ids"
+    "MESSAGE_REACTION_ADD"      -> InternalMessageReactionAdd <$> reparse o
+    "MESSAGE_REACTION_REMOVE"   -> InternalMessageReactionRemove <$> reparse o
+    "MESSAGE_REACTION_REMOVE_ALL" -> InternalMessageReactionRemoveAll <$> o .: "channel_id"
+                                                                      <*> o .: "message_id"
+    "MESSAGE_REACTION_REMOVE_EMOJI" -> InternalMessageReactionRemoveEmoji <$> reparse o
+    "PRESENCE_UPDATE"           -> InternalPresenceUpdate            <$> reparse o
+    "TYPING_START"              -> InternalTypingStart               <$> reparse o
+    "USER_UPDATE"               -> InternalUserUpdate                <$> reparse o
+ 
+ 
+    "INTERACTION_CREATE"        -> InternalInteractionCreate         <$> reparse o
+    _other_event                -> InternalUnknownEvent t            <$> reparse o

+ src/Sigmacord/Internal/Types/Gateway.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE RecordWildCards #-}
+
+
+
+module Sigmacord.Internal.Types.Gateway where
+
+import System.Info
+
+import qualified Data.Text as T
+import Data.Time (UTCTime)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Default (Default, def)
+import Data.Maybe (fromMaybe)
+import Data.Functor
+import Text.Read (readMaybe)
+
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.Events
+import Sigmacord.Internal.Types.Guild (Activity (..))
+
+
+data GatewayReceivable
+  = Dispatch EventInternalParse Integer
+  | HeartbeatRequest Integer
+  | Reconnect
+  | InvalidSession Bool
+  | Hello Integer
+  | HeartbeatAck
+  | ParseError T.Text
+  deriving (Show, Eq, Read)
+
+
+data GatewaySendableInternal
+  = Heartbeat Integer
+  | Identify Auth GatewayIntent (Int, Int)
+  | Resume Auth T.Text Integer
+  deriving (Show, Read, Eq, Ord)
+
+
+
+
+
+
+data GatewayIntent = GatewayIntent
+  { gatewayIntentGuilds :: Bool
+  , gatewayIntentMembers :: Bool
+  , gatewayIntentBans :: Bool
+  , gatewayIntentEmojis :: Bool
+  , gatewayIntentIntegrations :: Bool
+  , gatewayIntentWebhooks :: Bool
+  , gatewayIntentInvites :: Bool
+  , gatewayIntentVoiceStates :: Bool
+  , gatewayIntentPresences :: Bool
+  , gatewayIntentMessageChanges :: Bool
+  , gatewayIntentMessageReactions :: Bool
+  , gatewayIntentMessageTyping :: Bool
+  , gatewayIntentDirectMessageChanges :: Bool
+  , gatewayIntentDirectMessageReactions :: Bool
+  , gatewayIntentDirectMessageTyping :: Bool
+  , gatewayIntentMessageContent :: Bool
+  } deriving (Show, Read, Eq, Ord)
+
+instance Default GatewayIntent where
+  def = GatewayIntent { gatewayIntentGuilds                 = True
+                      , gatewayIntentMembers                = False 
+                      , gatewayIntentBans                   = True
+                      , gatewayIntentEmojis                 = True
+                      , gatewayIntentIntegrations           = True
+                      , gatewayIntentWebhooks               = True
+                      , gatewayIntentInvites                = True
+                      , gatewayIntentVoiceStates            = True
+                      , gatewayIntentPresences              = False  
+                      , gatewayIntentMessageChanges         = True
+                      , gatewayIntentMessageReactions       = True
+                      , gatewayIntentMessageTyping          = True
+                      , gatewayIntentDirectMessageChanges   = True
+                      , gatewayIntentDirectMessageReactions = True
+                      , gatewayIntentDirectMessageTyping    = True
+                      , gatewayIntentMessageContent         = True
+                      }
+
+compileGatewayIntent :: GatewayIntent -> Int
+compileGatewayIntent GatewayIntent{..} =
+ sum $ [ if on then flag else 0
+       | (flag, on) <- [ (     1, gatewayIntentGuilds)
+                       , (2 ^  1, gatewayIntentMembers)
+                       , (2 ^  2, gatewayIntentBans)
+                       , (2 ^  3, gatewayIntentEmojis)
+                       , (2 ^  4, gatewayIntentIntegrations)
+                       , (2 ^  5, gatewayIntentWebhooks)
+                       , (2 ^  6, gatewayIntentInvites)
+                       , (2 ^  7, gatewayIntentVoiceStates)
+                       , (2 ^  8, gatewayIntentPresences)
+                       , (2 ^  9, gatewayIntentMessageChanges)
+                       , (2 ^ 10, gatewayIntentMessageReactions)
+                       , (2 ^ 11, gatewayIntentMessageTyping)
+                       , (2 ^ 12, gatewayIntentDirectMessageChanges)
+                       , (2 ^ 13, gatewayIntentDirectMessageReactions)
+                       , (2 ^ 14, gatewayIntentDirectMessageTyping)
+                       , (2 ^ 15, gatewayIntentMessageContent)
+                       ]
+       ]
+
+
+data GatewaySendable
+  = RequestGuildMembers RequestGuildMembersOpts
+  | UpdateStatus UpdateStatusOpts
+  | UpdateStatusVoice UpdateStatusVoiceOpts
+  deriving (Show, Read, Eq, Ord)
+
+
+data RequestGuildMembersOpts = RequestGuildMembersOpts
+                             { requestGuildMembersOptsGuildId :: GuildId
+                             , requestGuildMembersOptsNamesStartingWith :: T.Text
+                             , requestGuildMembersOptsLimit :: Integer }
+  deriving (Show, Read, Eq, Ord)
+
+
+data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts
+                           { updateStatusVoiceOptsGuildId :: GuildId
+                           , updateStatusVoiceOptsChannelId :: Maybe ChannelId
+                           , updateStatusVoiceOptsIsMuted :: Bool
+                           , updateStatusVoiceOptsIsDeaf :: Bool
+                           }
+  deriving (Show, Read, Eq, Ord)
+
+
+data UpdateStatusOpts = UpdateStatusOpts
+                      { updateStatusOptsSince :: Maybe UTCTime
+                      , updateStatusOptsGame :: Maybe Activity
+                      , updateStatusOptsNewStatus :: UpdateStatusType
+                      , updateStatusOptsAFK :: Bool
+                      }
+  deriving (Show, Read, Eq, Ord)
+
+
+data UpdateStatusType = UpdateStatusOnline
+                      | UpdateStatusDoNotDisturb
+                      | UpdateStatusAwayFromKeyboard
+                      | UpdateStatusInvisibleOffline
+                      | UpdateStatusOffline
+  deriving (Show, Read, Eq, Ord, Enum)
+
+
+
+statusString :: UpdateStatusType -> T.Text
+statusString s = case s of
+  UpdateStatusOnline -> "online"
+  UpdateStatusDoNotDisturb -> "dnd"
+  UpdateStatusAwayFromKeyboard -> "idle"
+  UpdateStatusInvisibleOffline -> "invisible"
+  UpdateStatusOffline -> "offline"
+
+instance FromJSON GatewayReceivable where
+  parseJSON = withObject "payload" $ \o -> do
+    op <- o .: "op" :: Parser Int
+    case op of
+      0  -> do etype <- o .: "t"
+               ejson <- o .: "d"
+               case ejson of
+                 Object hm -> Dispatch <$> eventParse etype hm <*> o .: "s"
+                 _other -> Dispatch (InternalUnknownEvent "Dispatch payload wasn't an object" o)
+                                  <$> o .: "s"
+      1  -> HeartbeatRequest . fromMaybe 0 . readMaybe <$> o .: "d"
+      7  -> pure Reconnect
+      9  -> InvalidSession <$> o .: "d"
+      10 -> do od <- o .: "d"
+               int <- od .: "heartbeat_interval"
+               pure (Hello int)
+      11 -> pure HeartbeatAck
+      _  -> fail ("Unknown Receivable payload ID:" <> show op)
+
+
+
+
+
+
+
+
+
+
+
+
+instance ToJSON GatewaySendableInternal where
+  toJSON (Heartbeat i) = object [ "op" .= (1 :: Int), "d" .= if i <= 0 then "null" else show i ]
+  toJSON (Identify token intent shard) = object [
+      "op" .= (2 :: Int)
+    , "d"  .= object [
+        "token" .= authToken token
+      , "intents" .= compileGatewayIntent intent
+      , "properties" .= object [
+          "$os"                .= os
+        , "$browser"           .= ("Sigmacord-haskell" :: T.Text)
+        , "$device"            .= ("Sigmacord-haskell" :: T.Text)
+        , "$referrer"          .= (""                :: T.Text)
+        , "$referring_domain"  .= (""                :: T.Text)
+        ]
+      , "compress" .= False
+      , "large_threshold" .= (50 :: Int) 
+      , "shard" .= shard
+      ]
+    ]
+  toJSON (Resume token session seqId) = object [
+      "op" .= (6 :: Int)
+    , "d"  .= object [
+        "token"      .= authToken token
+      , "session_id" .= session
+      , "seq"        .= seqId
+      ]
+    ]
+
+instance ToJSON GatewaySendable where
+  toJSON (UpdateStatus (UpdateStatusOpts since game status afk)) = object [
+      "op" .= (3 :: Int)
+    , "d"  .= object [
+        "since" .= (since <&> \s -> 1000 * utcTimeToPOSIXSeconds s) 
+      , "afk" .= afk
+      , "status" .= statusString status
+      , "game" .= (game <&> \a -> object [
+                                "name" .= activityName a
+                              , "type" .= fromSigmacordType (activityType a)
+                              , "url" .= activityUrl a
+                              ])
+      ]
+    ]
+  toJSON (UpdateStatusVoice (UpdateStatusVoiceOpts guild channel mute deaf)) =
+    object [
+      "op" .= (4 :: Int)
+    , "d"  .= object [
+        "guild_id"   .= guild
+      , "channel_id" .= channel
+      , "self_mute"  .= mute
+      , "self_deaf"  .= deaf
+      ]
+    ]
+  toJSON (RequestGuildMembers (RequestGuildMembersOpts guild query limit)) =
+    object [
+      "op" .= (8 :: Int)
+    , "d"  .= object [
+        "guild_id" .= guild
+      , "query"    .= query
+      , "limit"    .= limit
+      ]
+    ]

+ src/Sigmacord/Internal/Types/Guild.hs view
@@ -0,0 +1,410 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+
+module Sigmacord.Internal.Types.Guild where
+
+import Data.Time.Clock
+
+import Data.Aeson
+import qualified Data.Text as T
+import Data.Data (Data)
+import Data.Default (Default(..))
+
+import Sigmacord.Internal.Types.Prelude
+import Sigmacord.Internal.Types.Color (SigmacordColor)
+import Sigmacord.Internal.Types.User (User)
+import Sigmacord.Internal.Types.Emoji (Emoji, StickerItem)
+import Data.List
+
+
+
+
+
+data Guild = Guild
+      { guildId                   :: GuildId              
+      , guildName                 :: T.Text               
+      , guildIcon                 :: Maybe T.Text         
+      , guildIconHash             :: Maybe T.Text         
+      , guildSplash               :: Maybe T.Text         
+      , guildDiscoverySplash      :: Maybe T.Text         
+      , guildOwner                :: Maybe Bool           
+      , guildOwnerId              :: UserId               
+      , guildPermissions          :: Maybe T.Text         
+      , guildAfkId                :: Maybe ChannelId      
+      , guildAfkTimeout           :: Integer              
+      , guildWidgetEnabled        :: Maybe Bool           
+      , guildWidgetChannelId      :: Maybe ChannelId      
+      , guildVerificationLevel    :: Integer              
+      , guildNotification         :: Integer              
+      , guildExplicitFilterLevel  :: Integer              
+      , guildRoles                :: [Role]               
+      , guildEmojis               :: [Emoji]              
+      , guildFeatures             :: [T.Text]             
+      , guildMultiFactAuth        :: !Integer             
+      , guildApplicationId        :: Maybe ApplicationId  
+      , guildSystemChannelId      :: Maybe ChannelId      
+      , guildSystemChannelFlags   :: Integer              
+      , guildRulesChannelId       :: Maybe ChannelId      
+      , guildMaxPresences         :: Maybe Integer        
+      , guildMaxMembers           :: Maybe Integer        
+      , guildVanityURL            :: Maybe T.Text         
+      , guildDescription          :: Maybe T.Text         
+      , guildBanner               :: Maybe T.Text         
+      , guildPremiumTier          :: Integer              
+      , guildSubscriptionCount    :: Maybe Integer        
+      , guildPreferredLocale      :: T.Text               
+      , guildPublicUpdatesChannel :: Maybe ChannelId      
+      , guildMaxVideoUsers        :: Maybe Integer        
+      , guildApproxMemberCount    :: Maybe Integer        
+      , guildApproxPresenceCount  :: Maybe Integer        
+      
+      , guildNSFWLevel            :: Integer              
+      
+      , guildStickers             :: Maybe [StickerItem]  
+      
+      , guildPremiumBar           :: Bool                 
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Guild where
+  parseJSON = withObject "Guild" $ \o ->
+    Guild <$> o .:  "id"
+          <*> o .:  "name"
+          <*> o .:? "icon"
+          <*> o .:? "icon_hash"
+          <*> o .:? "splash"
+          <*> o .:? "discovery_splash"
+          <*> o .:? "owner"
+          <*> o .:  "owner_id"
+          <*> o .:? "permissions"
+          <*> o .:? "afk_channel_id"
+          <*> o .:  "afk_timeout"
+          <*> o .:? "widget_enabled"
+          <*> o .:? "widget_channel_id"
+          <*> o .:  "verification_level"
+          <*> o .:  "default_message_notifications"
+          <*> o .:  "explicit_content_filter"
+          <*> o .:  "roles"
+          <*> o .:  "emojis"
+          <*> o .:  "features"
+          <*> o .:  "mfa_level"
+          <*> o .:? "application_id"
+          <*> o .:? "system_channel_id"
+          <*> o .:  "system_channel_flags"
+          <*> o .:? "rules_channel_id"
+          <*> o .:? "max_presences"
+          <*> o .:? "max_members"
+          <*> o .:? "vanity_url_code"
+          <*> o .:? "description"
+          <*> o .:? "banner"
+          <*> o .:  "premium_tier"
+          <*> o .:? "premium_subscription_count"
+          <*> o .:  "preferred_locale"
+          <*> o .:? "public_updates_channel_id"
+          <*> o .:? "max_video_channel_users"
+          <*> o .:? "approximate_member_count"
+          <*> o .:? "approximate_presence_count"
+          
+          <*> o .: "nsfw_level"
+          
+          <*> o .:? "stickers"
+          <*> o .: "premium_progress_bar_enabled"
+
+newtype GuildUnavailable = GuildUnavailable
+      { idOnceAvailable :: GuildId
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON GuildUnavailable where
+  parseJSON = withObject "GuildUnavailable" $ \o ->
+       GuildUnavailable <$> o .: "id"
+
+data PresenceInfo = PresenceInfo
+  { presenceUserId     :: UserId
+  
+  , presenceActivities :: Maybe [Activity]
+  , presenceGuildId    :: Maybe GuildId
+  , presenceStatus     :: T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON PresenceInfo where
+  parseJSON = withObject "PresenceInfo" $ \o ->
+    PresenceInfo <$> (o .: "user" >>= (.: "id"))
+                 <*> o .:  "activities"
+                 <*> o .:? "guild_id"
+                 <*> o .:  "status"
+
+
+
+
+
+
+
+data Activity =
+  Activity
+    { activityName :: T.Text 
+    , activityType :: ActivityType 
+    , activityUrl :: Maybe T.Text 
+    , activityCreatedAt :: Integer 
+    , activityTimeStamps :: Maybe ActivityTimestamps 
+    , activityApplicationId :: Maybe ApplicationId 
+    , activityDetails :: Maybe T.Text 
+    , activityState :: Maybe T.Text 
+    , activityEmoji :: Maybe Emoji 
+    , activityParty :: Maybe ActivityParty 
+    
+    
+    , activityInstance :: Maybe Bool 
+    , activityFlags :: Maybe Integer 
+    , activityButtons :: Maybe [ActivityButton] 
+    }
+  deriving (Show, Read, Eq, Ord)
+
+instance Default Activity where
+  def = Activity "Sigmacord-haskell" ActivityTypeGame Nothing 0 Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+instance FromJSON Activity where
+  parseJSON = withObject "Activity" $ \o -> do
+    Activity <$> o .:  "name"
+             <*> o .:  "type"
+             <*> o .:? "url"
+             <*> o .:  "created_at"
+             <*> o .:? "timestamps"
+             <*> o .:? "application_id"
+             <*> o .:? "details"
+             <*> o .:? "state"
+             <*> o .:? "emoji"
+             <*> o .:? "party"
+             
+             
+             <*> o .:? "instance"
+             <*> o .:? "flags"
+             <*> o .:? "buttons"
+
+data ActivityTimestamps = ActivityTimestamps
+  { activityTimestampsStart :: Maybe Integer 
+  , activityTimestampsEnd :: Maybe Integer 
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ActivityTimestamps where
+  parseJSON = withObject "ActivityTimestamps" $ \o ->
+    ActivityTimestamps <$> o .:? "start"
+                       <*> o .:? "end"
+
+data ActivityParty = ActivityParty
+  { activityPartyId :: Maybe T.Text
+  , activityPartySize :: Maybe (Integer, Integer)
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ActivityParty where
+  parseJSON = withObject "ActivityParty" $ \o ->
+    ActivityParty <$> o .:? "id"
+                  <*> o .:? "size"
+
+data ActivityButton = ActivityButton
+  { activityButtonLabel :: T.Text
+  , activityButtonUrl :: T.Text
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ActivityButton where
+  parseJSON = withObject "ActivityButton" $ \o ->
+    ActivityButton <$> o .: "label"
+                   <*> o .: "url"
+
+
+
+data ActivityType =
+    ActivityTypeGame
+  | ActivityTypeStreaming
+  | ActivityTypeListening
+  | ActivityTypeWatching
+  | ActivityTypeCustom
+  | ActivityTypeCompeting
+  deriving (Show, Read, Eq, Ord, Data)
+
+instance InternalSigmacordEnum ActivityType where
+  SigmacordTypeStartValue = ActivityTypeGame
+  fromSigmacordType ActivityTypeGame = 0
+  fromSigmacordType ActivityTypeStreaming = 1
+  fromSigmacordType ActivityTypeListening = 2
+  fromSigmacordType ActivityTypeWatching = 3
+  fromSigmacordType ActivityTypeCustom = 4
+  fromSigmacordType ActivityTypeCompeting = 5
+
+instance FromJSON ActivityType where
+  parseJSON = SigmacordTypeParseJSON "ActivityType"
+
+data PartialGuild = PartialGuild
+      { partialGuildId          :: GuildId
+      , partialGuildName        :: T.Text
+      , partialGuildIcon        :: Maybe T.Text
+      , partialGuildOwner       :: Bool
+      , partialGuildPermissions :: T.Text
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON PartialGuild where
+  parseJSON = withObject "PartialGuild" $ \o ->
+    PartialGuild <$> o .:  "id"
+                 <*> o .:  "name"
+                 <*> o .:? "icon"
+                 <*> o .:?  "owner" .!= False
+                 <*> o .:  "permissions"
+
+
+
+
+
+
+data Role =
+    Role {
+        roleId      :: RoleId 
+      , roleName    :: T.Text                    
+      , roleColor   :: SigmacordColor              
+      , roleHoist   :: Bool                      
+      , rolePos     :: Integer                   
+      , rolePerms   :: RolePermissions           
+      , roleManaged :: Bool                      
+      , roleMention :: Bool                      
+    } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Role where
+  parseJSON = withObject "Role" $ \o ->
+    Role <$> o .: "id"
+         <*> o .: "name"
+         <*> o .: "color"
+         <*> o .: "hoist"
+         <*> o .: "position"
+         <*> o .: "permissions"
+         <*> o .: "managed"
+         <*> o .: "mentionable"
+
+
+
+
+roleIdToRole :: Guild -> RoleId -> Maybe Role
+roleIdToRole  g r = find(\x -> roleId x == r) $ guildRoles g
+
+
+
+data VoiceRegion = VoiceRegion
+      { voiceRegionId          :: T.Text      
+      , voiceRegionName        :: T.Text      
+      , voiceRegionVip         :: Bool        
+      , voiceRegionOptimal     :: Bool        
+      , voiceRegionDeprecated  :: Bool        
+      , voiceRegionCustom      :: Bool        
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON VoiceRegion where
+  parseJSON = withObject "VoiceRegion" $ \o ->
+    VoiceRegion <$> o .: "id"
+                <*> o .: "name"
+                <*> o .: "vip"
+                <*> o .: "optimal"
+                <*> o .: "deprecated"
+                <*> o .: "custom"
+
+
+data GuildBan = GuildBan
+      { guildBanReason  :: T.Text
+      , guildBanUser    :: User
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON GuildBan where
+  parseJSON = withObject "GuildBan" $ \o -> GuildBan <$> o .: "reason" <*> o .: "user"
+
+
+data Invite = Invite
+      { inviteCode  :: T.Text    
+      , inviteGuildId :: Maybe GuildId 
+      , inviteChannelId :: ChannelId 
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Invite where
+  parseJSON = withObject "Invite" $ \o ->
+    Invite <$>  o .: "code"
+           <*> (do g <- o .:? "guild"
+                   case g of Just g2 -> g2 .: "id"
+                             Nothing -> pure Nothing)
+           <*> ((o .:  "channel") >>= (.: "id"))
+
+
+data InviteWithMeta = InviteWithMeta Invite InviteMeta
+
+instance FromJSON InviteWithMeta where
+  parseJSON ob = InviteWithMeta <$> parseJSON ob <*> parseJSON ob
+
+
+data InviteMeta = InviteMeta
+    { inviteCreator :: User    
+    , inviteUses    :: Integer 
+    , inviteMax     :: Integer 
+    , inviteAge     :: Integer 
+    , inviteTemp    :: Bool    
+    , inviteCreated :: UTCTime 
+    , inviteRevoked :: Bool    
+    } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON InviteMeta where
+  parseJSON = withObject "InviteMeta" $ \o ->
+    InviteMeta <$> o .: "inviter"
+               <*> o .: "uses"
+               <*> o .: "max_uses"
+               <*> o .: "max_age"
+               <*> o .: "temporary"
+               <*> o .: "created_at"
+               <*> o .: "revoked"
+
+
+data Integration = Integration
+      { integrationId       :: !Snowflake 
+      , integrationName     :: T.Text                    
+      , integrationType     :: T.Text                    
+      , integrationEnabled  :: Bool                      
+      , integrationSyncing  :: Bool                      
+      , integrationRole     :: RoleId                 
+      , integrationBehavior :: Integer                   
+      , integrationGrace    :: Integer                   
+      , integrationOwner    :: User                      
+      , integrationAccount  :: IntegrationAccount        
+      , integrationSync     :: UTCTime                   
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Integration where
+  parseJSON = withObject "Integration" $ \o ->
+    Integration <$> o .: "id"
+                <*> o .: "name"
+                <*> o .: "type"
+                <*> o .: "enabled"
+                <*> o .: "syncing"
+                <*> o .: "role_id"
+                <*> o .: "expire_behavior"
+                <*> o .: "expire_grace_period"
+                <*> o .: "user"
+                <*> o .: "account"
+                <*> o .: "synced_at"
+
+
+data IntegrationAccount = IntegrationAccount
+    { accountId   :: T.Text 
+    , accountName :: T.Text 
+    } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON IntegrationAccount where
+  parseJSON = withObject "IntegrationAccount" $ \o ->
+    IntegrationAccount <$> o .: "id" <*> o .: "name"
+
+
+data GuildWidget = GuildWidget
+      { widgetEnabled :: Bool      
+      , widgetChannelId :: ChannelId 
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON GuildWidget where
+  parseJSON = withObject "GuildWidget" $ \o ->
+    GuildWidget <$> o .: "enabled" <*> o .: "channel_id"
+
+instance ToJSON GuildWidget where
+  toJSON (GuildWidget enabled snowflake) = object
+    [ "enabled"   .= enabled
+    , "channel_id" .= snowflake
+    ]

+ src/Sigmacord/Internal/Types/Interactions.hs view
@@ -0,0 +1,665 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Sigmacord.Internal.Types.Interactions
+  ( Interaction (..),
+    ComponentData (..),
+    ApplicationCommandData (..),
+    OptionsData (..),
+    OptionDataSubcommandOrGroup (..),
+    OptionDataSubcommand (..),
+    OptionDataValue (..),
+    InteractionToken,
+    ResolvedData (..),
+    MemberOrUser (..),
+    InteractionResponse (..),
+    interactionResponseBasic,
+    InteractionResponseAutocomplete (..),
+    InteractionResponseMessage (..),
+    interactionResponseMessageBasic,
+    InteractionResponseMessageFlags (..),
+    InteractionResponseMessageFlag (..),
+    InteractionResponseModalData (..),
+  )
+where
+
+import Control.Applicative (Alternative ((<|>)))
+import Control.Monad (join)
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.Bits (Bits (shift, (.|.)))
+import Data.Foldable (Foldable (toList))
+import qualified Data.Text as T
+import Sigmacord.Internal.Types.ApplicationCommands (Choice, Number)
+import Sigmacord.Internal.Types.Channel (AllowedMentions, Attachment, Message)
+import Sigmacord.Internal.Types.Components (ActionRow, TextInput)
+import Sigmacord.Internal.Types.Embed (CreateEmbed, createEmbed)
+import Sigmacord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId, objectFromMaybes, (.=?))
+import Sigmacord.Internal.Types.User (GuildMember, User)
+
+
+data Interaction
+  = InteractionComponent
+      { 
+        interactionId :: InteractionId,
+        
+        interactionApplicationId :: ApplicationId,
+        
+        componentData :: ComponentData,
+        
+        interactionGuildId :: Maybe GuildId,
+        
+        interactionChannelId :: Maybe ChannelId,
+        
+        interactionUser :: MemberOrUser,
+        
+        interactionToken :: InteractionToken,
+        
+        interactionVersion :: Int,
+        
+        interactionMessage :: Message,
+        
+        interactionPermissions :: Maybe T.Text,
+        
+        interactionLocale :: T.Text,
+        
+        interactionGuildLocale :: Maybe T.Text
+      }
+  | InteractionPing
+      { 
+        interactionId :: InteractionId,
+        
+        interactionApplicationId :: ApplicationId,
+        
+        interactionToken :: InteractionToken,
+        
+        interactionVersion :: Int,
+        
+        interactionPermissions :: Maybe T.Text
+      }
+  | InteractionApplicationCommand
+      { 
+        interactionId :: InteractionId,
+        
+        interactionApplicationId :: ApplicationId,
+        
+        applicationCommandData :: ApplicationCommandData,
+        
+        interactionGuildId :: Maybe GuildId,
+        
+        interactionChannelId :: Maybe ChannelId,
+        
+        interactionUser :: MemberOrUser,
+        
+        interactionToken :: InteractionToken,
+        
+        interactionVersion :: Int,
+        
+        interactionPermissions :: Maybe T.Text,
+        
+        interactionLocale :: T.Text,
+        
+        interactionGuildLocale :: Maybe T.Text
+      }
+  | InteractionApplicationCommandAutocomplete
+      { 
+        interactionId :: InteractionId,
+        
+        interactionApplicationId :: ApplicationId,
+        
+        applicationCommandData :: ApplicationCommandData,
+        
+        interactionGuildId :: Maybe GuildId,
+        
+        interactionChannelId :: Maybe ChannelId,
+        
+        interactionUser :: MemberOrUser,
+        
+        interactionToken :: InteractionToken,
+        
+        interactionVersion :: Int,
+        
+        interactionPermissions :: Maybe T.Text,
+        
+        interactionLocale :: T.Text,
+        
+        interactionGuildLocale :: Maybe T.Text
+      }
+  | InteractionModalSubmit
+      { 
+        interactionId :: InteractionId,
+        
+        interactionApplicationId :: ApplicationId,
+        
+        modalData :: ModalData,
+        
+        interactionGuildId :: Maybe GuildId,
+        
+        interactionChannelId :: Maybe ChannelId,
+        
+        interactionUser :: MemberOrUser,
+        
+        interactionToken :: InteractionToken,
+        
+        interactionVersion :: Int,
+        
+        interactionPermissions :: Maybe T.Text,
+        
+        interactionLocale :: T.Text,
+        
+        interactionGuildLocale :: Maybe T.Text
+      }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Interaction where
+  parseJSON =
+    withObject
+      "Interaction"
+      ( \v -> do
+          iid <- v .: "id"
+          aid <- v .: "application_id"
+          gid <- v .:? "guild_id"
+          cid <- v .:? "channel_id"
+          tok <- v .: "token"
+          version <- v .: "version"
+          glocale <- v .:? "guild_locale"
+          permissions <- v .:? "app_permissions"
+          t <- v .: "type" :: Parser Int
+          case t of
+            1 -> return $ InteractionPing iid aid tok version permissions
+            2 ->
+              InteractionApplicationCommand iid aid
+                <$> v .: "data"
+                <*> return gid
+                <*> return cid
+                <*> parseJSON (Object v)
+                <*> return tok
+                <*> return version
+                <*> return permissions
+                <*> v .: "locale"
+                <*> return glocale
+            3 ->
+              InteractionComponent iid aid
+                <$> v .: "data"
+                <*> return gid
+                <*> return cid
+                <*> parseJSON (Object v)
+                <*> return tok
+                <*> return version
+                <*> v .: "message"
+                <*> return permissions
+                <*> v .: "locale"
+                <*> return glocale
+            4 ->
+              InteractionApplicationCommandAutocomplete iid aid
+                <$> v .: "data"
+                <*> return gid
+                <*> return cid
+                <*> parseJSON (Object v)
+                <*> return tok
+                <*> return version
+                <*> return permissions
+                <*> v .: "locale"
+                <*> return glocale
+            5 ->
+              InteractionModalSubmit iid aid
+                <$> v .: "data"
+                <*> return gid
+                <*> return cid
+                <*> parseJSON (Object v)
+                <*> return tok
+                <*> return version
+                <*> return permissions
+                <*> v .: "locale"
+                <*> return glocale
+            _ -> fail "unknown interaction type"
+      )
+
+newtype MemberOrUser = MemberOrUser (Either GuildMember User)
+  deriving (Show, Read, Eq, Ord)
+
+instance {-# OVERLAPPING #-} FromJSON MemberOrUser where
+  parseJSON =
+    withObject
+      "MemberOrUser"
+      ( \v -> MemberOrUser <$> (Left <$> v .: "member" <|> Right <$> v .: "user")
+      )
+
+data ComponentData
+  = ButtonData
+      { 
+        componentDataCustomId :: T.Text
+      }
+  | SelectMenuData
+      { 
+        componentDataCustomId :: T.Text,
+        
+        componentDataValues :: SelectMenuData
+      }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ComponentData where
+  parseJSON =
+    withObject
+      "ComponentData"
+      ( \v -> do
+          cid <- v .: "custom_id"
+          t <- v .: "component_type" :: Parser Int
+          case t of
+            2 -> return $ ButtonData cid
+            _ | t `elem` [3, 5, 6, 7, 8] ->
+              SelectMenuData cid
+                <$> parseJSON (toJSON v)
+            _ -> fail $ "unknown interaction data component type: " <> show t
+      )
+
+data SelectMenuData
+  = SelectMenuDataText [T.Text] 
+  | SelectMenuDataUser [UserId] 
+  | SelectMenuDataRole [RoleId] 
+  | SelectMenuDataMentionable [Snowflake] 
+  | SelectMenuDataChannels [ChannelId] 
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON SelectMenuData where
+  parseJSON =
+    withObject
+      "SelectMenuData"
+      $ \v -> do
+          t <- v .: "component_type" :: Parser Int
+          let cons :: forall a. FromJSON a => ([a] -> SelectMenuData) -> Parser SelectMenuData
+              cons f = f <$> v .: "values"
+          case t of
+            3 -> cons SelectMenuDataText
+            5 -> cons SelectMenuDataUser
+            6 -> cons SelectMenuDataRole
+            7 -> cons SelectMenuDataMentionable
+            8 -> cons SelectMenuDataChannels
+            _ -> fail $ "unknown SelectMenuData type: " <> show t
+
+data ApplicationCommandData
+  = ApplicationCommandDataUser
+      { 
+        applicationCommandDataId :: ApplicationCommandId,
+        
+        applicationCommandDataName :: T.Text,
+        
+        resolvedData :: Maybe ResolvedData,
+        
+        applicationCommandDataTargetUserId :: UserId
+      }
+  | ApplicationCommandDataMessage
+      { 
+        applicationCommandDataId :: ApplicationCommandId,
+        
+        applicationCommandDataName :: T.Text,
+        
+        resolvedData :: Maybe ResolvedData,
+        
+        applicationCommandDataTargetMessageId :: MessageId
+      }
+  | ApplicationCommandDataChatInput
+      { 
+        applicationCommandDataId :: ApplicationCommandId,
+        
+        applicationCommandDataName :: T.Text,
+        
+        resolvedData :: Maybe ResolvedData,
+        
+        optionsData :: Maybe OptionsData
+      }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ApplicationCommandData where
+  parseJSON =
+    withObject
+      "ApplicationCommandData"
+      ( \v -> do
+          aci <- v .: "id"
+          name <- v .: "name"
+          rd <- v .:? "resolved_data"
+          t <- v .: "type" :: Parser Int
+          case t of
+            1 ->
+              ApplicationCommandDataChatInput aci name rd
+                <$> v .:? "options"
+            2 ->
+              ApplicationCommandDataUser aci name rd
+                <$> v .: "target_id"
+            3 ->
+              ApplicationCommandDataMessage aci name rd
+                <$> v .: "target_id"
+            _ -> fail "unknown interaction data component type"
+      )
+
+
+data OptionsData
+  = OptionsDataSubcommands [OptionDataSubcommandOrGroup]
+  | OptionsDataValues [OptionDataValue]
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON OptionsData where
+  parseJSON =
+    withArray
+      "OptionsData"
+      ( \a -> do
+          let a' = toList a
+          case a' of
+            [] -> return $ OptionsDataValues []
+            (v' : _) ->
+              withObject
+                "OptionsData item"
+                ( \v -> do
+                    t <- v .: "type" :: Parser Int
+                    if t == 1 || t == 2
+                      then OptionsDataSubcommands <$> mapM parseJSON a'
+                      else OptionsDataValues <$> mapM parseJSON a'
+                )
+                v'
+      )
+
+
+data OptionDataSubcommandOrGroup
+  = OptionDataSubcommandGroup
+      { optionDataSubcommandGroupName :: T.Text,
+        optionDataSubcommandGroupOptions :: [OptionDataSubcommand],
+        optionDataSubcommandGroupFocused :: Bool
+      }
+  | OptionDataSubcommandOrGroupSubcommand OptionDataSubcommand
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON OptionDataSubcommandOrGroup where
+  parseJSON =
+    withObject
+      "OptionDataSubcommandOrGroup"
+      ( \v -> do
+          t <- v .: "type" :: Parser Int
+          case t of
+            2 ->
+              OptionDataSubcommandGroup
+                <$> v .: "name"
+                <*> v .: "options"
+                <*> v .:? "focused" .!= False
+            1 -> OptionDataSubcommandOrGroupSubcommand <$> parseJSON (Object v)
+            _ -> fail "unexpected subcommand group type"
+      )
+
+
+data OptionDataSubcommand = OptionDataSubcommand
+  { optionDataSubcommandName :: T.Text,
+    optionDataSubcommandOptions :: [OptionDataValue],
+    optionDataSubcommandFocused :: Bool
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON OptionDataSubcommand where
+  parseJSON =
+    withObject
+      "OptionDataSubcommand"
+      ( \v -> do
+          t <- v .: "type" :: Parser Int
+          case t of
+            1 ->
+              OptionDataSubcommand
+                <$> v .: "name"
+                <*> v .:? "options" .!= []
+                <*> v .:? "focused" .!= False
+            _ -> fail "unexpected subcommand type"
+      )
+
+
+data OptionDataValue
+  = OptionDataValueString
+      { optionDataValueName :: T.Text,
+        optionDataValueString :: Either T.Text T.Text
+      }
+  | OptionDataValueInteger
+      { optionDataValueName :: T.Text,
+        optionDataValueInteger :: Either T.Text Integer
+      }
+  | OptionDataValueBoolean
+      { optionDataValueName :: T.Text,
+        optionDataValueBoolean :: Bool
+      }
+  | OptionDataValueUser
+      { optionDataValueName :: T.Text,
+        optionDataValueUser :: UserId
+      }
+  | OptionDataValueChannel
+      { optionDataValueName :: T.Text,
+        optionDataValueChannel :: ChannelId
+      }
+  | OptionDataValueRole
+      { optionDataValueName :: T.Text,
+        optionDataValueRole :: RoleId
+      }
+  | OptionDataValueMentionable
+      { optionDataValueName :: T.Text,
+        optionDataValueMentionable :: Snowflake
+      }
+  | OptionDataValueNumber
+      { optionDataValueName :: T.Text,
+        optionDataValueNumber :: Either T.Text Number
+      }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON OptionDataValue where
+  parseJSON =
+    withObject
+      "OptionDataValue"
+      ( \v -> do
+          name <- v .: "name"
+          focused <- v .:? "focused" .!= False
+          t <- v .: "type" :: Parser Int
+          case t of
+            3 ->
+              OptionDataValueString name
+                <$> parseValue v focused
+            4 ->
+              OptionDataValueInteger name
+                <$> parseValue v focused
+            10 ->
+              OptionDataValueNumber name
+                <$> parseValue v focused
+            5 ->
+              OptionDataValueBoolean name
+                <$> v .: "value"
+            6 ->
+              OptionDataValueUser name
+                <$> v .: "value"
+            7 ->
+              OptionDataValueChannel name
+                <$> v .: "value"
+            8 ->
+              OptionDataValueRole name
+                <$> v .: "value"
+            9 ->
+              OptionDataValueMentionable name
+                <$> v .: "value"
+            _ -> fail $ "unexpected interaction data application command option value type: " ++ show t
+      )
+
+data ModalData = ModalData
+  { 
+    modalDataCustomId :: T.Text,
+    
+    modalDataComponents :: [TextInput]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ModalData where
+  parseJSON =
+    withObject
+      "ModalData"
+      ( \v ->
+          ModalData <$> v .: "custom_id"
+            <*> ((v .: "components") >>= (join <$>) . mapM getTextInput)
+      )
+    where
+      getTextInput :: Value -> Parser [TextInput]
+      getTextInput = withObject "ModalData.TextInput" $ \o -> do
+        t <- o .: "type" :: Parser Int
+        case t of
+          1 -> o .: "components"
+          _ -> fail $ "expected action row type (1), got: " ++ show t
+
+parseValue :: (FromJSON a) => Object -> Bool -> Parser (Either T.Text a)
+parseValue o True = Left <$> o .: "value"
+parseValue o False = Right <$> o .: "value"
+
+
+
+
+
+
+
+
+
+
+data ResolvedData = ResolvedData
+  { resolvedDataUsers :: Maybe Value,
+    resolvedDataMembers :: Maybe Value,
+    resolvedDataRoles :: Maybe Value,
+    resolvedDataChannels :: Maybe Value,
+    resolvedDataMessages :: Maybe Value,
+    resolvedDataAttachments :: Maybe Value
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON ResolvedData where
+  toJSON ResolvedData {..} =
+    objectFromMaybes
+      [ "users" .=? resolvedDataUsers,
+        "members" .=? resolvedDataMembers,
+        "roles" .=? resolvedDataRoles,
+        "channels" .=? resolvedDataChannels,
+        "messages" .=? resolvedDataMessages,
+        "attachments" .=? resolvedDataAttachments
+      ]
+
+instance FromJSON ResolvedData where
+  parseJSON =
+    withObject
+      "ResolvedData"
+      ( \v ->
+          ResolvedData
+            <$> v .:? "users"
+            <*> v .:? "members"
+            <*> v .:? "roles"
+            <*> v .:? "channels"
+            <*> v .:? "messages"
+            <*> v .:? "attachments"
+      )
+
+
+
+
+data InteractionResponse
+  = 
+    InteractionResponsePong
+  | 
+    InteractionResponseChannelMessage InteractionResponseMessage
+  | 
+    InteractionResponseDeferChannelMessage
+  | 
+    InteractionResponseDeferUpdateMessage
+  | 
+    InteractionResponseUpdateMessage InteractionResponseMessage
+  | 
+    InteractionResponseAutocompleteResult InteractionResponseAutocomplete
+  | 
+    InteractionResponseModal InteractionResponseModalData
+  deriving (Show, Read, Eq, Ord)
+
+
+interactionResponseBasic :: T.Text -> InteractionResponse
+interactionResponseBasic t = InteractionResponseChannelMessage (interactionResponseMessageBasic t)
+
+instance ToJSON InteractionResponse where
+  toJSON InteractionResponsePong = object [("type", Number 1)]
+  toJSON InteractionResponseDeferChannelMessage = object [("type", Number 5)]
+  toJSON InteractionResponseDeferUpdateMessage = object [("type", Number 6)]
+  toJSON (InteractionResponseChannelMessage ms) = object [("type", Number 4), ("data", toJSON ms)]
+  toJSON (InteractionResponseUpdateMessage ms) = object [("type", Number 7), ("data", toJSON ms)]
+  toJSON (InteractionResponseAutocompleteResult ms) = object [("type", Number 8), ("data", toJSON ms)]
+  toJSON (InteractionResponseModal ms) = object [("type", Number 9), ("data", toJSON ms)]
+
+data InteractionResponseAutocomplete
+  = InteractionResponseAutocompleteString [Choice T.Text]
+  | InteractionResponseAutocompleteInteger [Choice Integer]
+  | InteractionResponseAutocompleteNumber [Choice Number]
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON InteractionResponseAutocomplete where
+  toJSON (InteractionResponseAutocompleteString cs) = object [("choices", toJSON cs)]
+  toJSON (InteractionResponseAutocompleteInteger cs) = object [("choices", toJSON cs)]
+  toJSON (InteractionResponseAutocompleteNumber cs) = object [("choices", toJSON cs)]
+
+
+data InteractionResponseMessage = InteractionResponseMessage
+  { interactionResponseMessageTTS :: Maybe Bool,
+    interactionResponseMessageContent :: Maybe T.Text,
+    interactionResponseMessageEmbeds :: Maybe [CreateEmbed],
+    interactionResponseMessageAllowedMentions :: Maybe AllowedMentions,
+    interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags,
+    interactionResponseMessageComponents :: Maybe [ActionRow],
+    interactionResponseMessageAttachments :: Maybe [Attachment]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+
+
+interactionResponseMessageBasic :: T.Text -> InteractionResponseMessage
+interactionResponseMessageBasic t = InteractionResponseMessage Nothing (Just t) Nothing Nothing Nothing Nothing Nothing
+
+instance ToJSON InteractionResponseMessage where
+  toJSON InteractionResponseMessage {..} =
+    objectFromMaybes
+      [ "tts" .=? interactionResponseMessageTTS,
+        "content" .=? interactionResponseMessageContent,
+        "embeds" .=? ((createEmbed <$>) <$> interactionResponseMessageEmbeds),
+        "allowed_mentions" .=? interactionResponseMessageAllowedMentions,
+        "flags" .=? interactionResponseMessageFlags,
+        "components" .=? interactionResponseMessageComponents,
+        "attachments" .=? interactionResponseMessageAttachments
+      ]
+
+
+
+
+
+data InteractionResponseMessageFlag = InteractionResponseMessageFlagEphermeral
+  deriving (Show, Read, Eq, Ord)
+
+newtype InteractionResponseMessageFlags = InteractionResponseMessageFlags [InteractionResponseMessageFlag]
+  deriving (Show, Read, Eq, Ord)
+
+instance Enum InteractionResponseMessageFlag where
+  fromEnum InteractionResponseMessageFlagEphermeral = 1 `shift` 6
+  toEnum i
+    | i == 1 `shift` 6 = InteractionResponseMessageFlagEphermeral
+    | otherwise = error $ "could not find InteractionCallbackDataFlag `" ++ show i ++ "`"
+
+instance ToJSON InteractionResponseMessageFlags where
+  toJSON (InteractionResponseMessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)
+
+data InteractionResponseModalData = InteractionResponseModalData
+  { interactionResponseModalCustomId :: T.Text,
+    interactionResponseModalTitle :: T.Text,
+    interactionResponseModalComponents :: [TextInput]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON InteractionResponseModalData where
+  toJSON InteractionResponseModalData {..} =
+    object
+      [ ("custom_id", toJSON interactionResponseModalCustomId),
+        ("title", toJSON interactionResponseModalTitle),
+        ("components", toJSON $ map (\ti -> object [("type", Number 1), ("components", toJSON [ti])]) interactionResponseModalComponents)
+      ]

+ src/Sigmacord/Internal/Types/Prelude.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE RankNTypes  #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+
+module Sigmacord.Internal.Types.Prelude
+  ( Auth (..)
+  , authToken
+
+  , Snowflake (..)
+  , snowflakeCreationDate
+
+  , RolePermissions (..)
+  
+  , SigmacordId (..)
+  , ChannelId
+  , StageId
+  , GuildId
+  , MessageId
+  , AttachmentId
+  , EmojiId
+  , StickerId
+  , UserId
+  , RoleId
+  , IntegrationId
+  , WebhookId
+  , ParentId
+  , ApplicationId
+  , ApplicationCommandId
+  , InteractionId
+  , ScheduledEventId
+  , ScheduledEventEntityId
+
+  , SigmacordToken (..)
+  , InteractionToken
+  , WebhookToken
+
+  , Shard
+  , epochTime
+
+  , InternalSigmacordEnum (..)
+
+  , Base64Image (..)
+  , getMimeType
+
+  , (.==)
+  , (.=?)
+  , AesonKey
+  , objectFromMaybes
+
+  , ChannelTypeOption (..)
+  )
+
+ where
+
+import Data.Bifunctor (first)
+import Data.Bits (Bits(shiftR))
+import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)
+import Data.Word (Word64)
+import Data.Maybe (catMaybes)
+import Text.Read (readMaybe)
+
+import Data.Aeson.Types
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+import Web.Internal.HttpApiData
+
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+
+#if MIN_VERSION_aeson(2, 0, 0)
+import qualified Data.Aeson.Key as Key
+#endif
+
+
+newtype Auth = Auth T.Text
+  deriving (Show, Read, Eq, Ord)
+
+
+
+authToken :: Auth -> T.Text
+authToken (Auth tok) = let token = T.strip tok
+                           bot = if "Bot " `T.isPrefixOf` token then "" else "Bot "
+                       in bot <> token
+
+
+newtype Snowflake = Snowflake { unSnowflake :: Word64 }
+  deriving (Ord, Eq, Num, Integral, Enum, Real, Bits)
+
+instance Show Snowflake where
+  show (Snowflake a) = show a
+
+instance Read Snowflake where
+  readsPrec p = fmap (first Snowflake) . readsPrec p
+
+instance ToJSON Snowflake where
+  toJSON (Snowflake snowflake) = String . T.pack $ show snowflake
+
+instance FromJSON Snowflake where
+  parseJSON =
+    withText
+      "Snowflake"
+      ( \snowflake ->
+          case readMaybe (T.unpack snowflake) of
+            Nothing -> fail "null snowflake"
+            (Just i) -> pure i
+      )
+
+instance ToHttpApiData Snowflake where
+  toUrlPiece = T.pack . show
+
+newtype RolePermissions = RolePermissions { getRolePermissions :: Integer } 
+  deriving (Eq, Ord, Num, Bits, Enum, Real, Integral)
+
+instance Read RolePermissions where
+  readsPrec p = fmap (first RolePermissions) . readsPrec p
+
+instance ToJSON RolePermissions where
+  toJSON = toJSON . getRolePermissions
+
+
+
+instance FromJSON RolePermissions where
+  parseJSON = withText "RolePermissions" $
+      \text -> case readMaybe (T.unpack text) of
+              Just perms -> pure $ RolePermissions perms
+              Nothing    -> fail "invalid role permissions integer string"
+
+instance Show RolePermissions where
+  show = show . getRolePermissions
+
+newtype SigmacordId a = SigmacordId { unId :: Snowflake }
+  deriving (Ord, Eq, Num, Integral, Enum, Real, Bits)
+
+instance Show (SigmacordId a) where
+  show = show . unId
+
+instance Read (SigmacordId a) where
+  readsPrec p = fmap (first SigmacordId) . readsPrec p
+
+instance ToJSON (SigmacordId a) where
+  toJSON = toJSON . unId
+
+instance FromJSON (SigmacordId a) where
+  parseJSON = fmap SigmacordId . parseJSON
+
+instance ToHttpApiData (SigmacordId a) where
+  toUrlPiece = T.pack . show
+
+data ChannelIdType
+type ChannelId = SigmacordId ChannelIdType
+
+data StageIdType
+type StageId = SigmacordId StageIdType
+
+data GuildIdType
+type GuildId = SigmacordId GuildIdType
+
+data MessageIdType
+type MessageId = SigmacordId MessageIdType
+
+data AttachmentIdType
+type AttachmentId = SigmacordId AttachmentIdType
+
+data EmojiIdType
+type EmojiId = SigmacordId EmojiIdType
+
+data StickerIdType
+type StickerId = SigmacordId StickerIdType
+
+data UserIdType
+type UserId = SigmacordId UserIdType
+
+data RoleIdType
+type RoleId = SigmacordId RoleIdType
+
+data IntegrationIdType
+type IntegrationId = SigmacordId IntegrationIdType
+
+data WebhookIdType
+type WebhookId = SigmacordId WebhookIdType
+
+data ParentIdType
+type ParentId = SigmacordId ParentIdType
+
+data ApplicationIdType
+type ApplicationId = SigmacordId ApplicationIdType
+
+data ApplicationCommandIdType
+type ApplicationCommandId = SigmacordId ApplicationCommandIdType
+
+data InteractionIdType
+type InteractionId = SigmacordId InteractionIdType
+
+data ScheduledEventIdType
+type ScheduledEventId = SigmacordId ScheduledEventIdType
+
+data ScheduledEventEntityIdType
+type ScheduledEventEntityId = SigmacordId ScheduledEventEntityIdType
+
+newtype SigmacordToken a = SigmacordToken { unToken :: T.Text }
+  deriving (Ord, Eq)
+
+instance Show (SigmacordToken a) where
+  show = show . unToken
+
+instance Read (SigmacordToken a) where
+  readsPrec p = fmap (first SigmacordToken) . readsPrec p
+
+instance ToJSON (SigmacordToken a) where
+  toJSON = toJSON . unToken
+
+instance FromJSON (SigmacordToken a) where
+  parseJSON = fmap SigmacordToken . parseJSON
+
+instance ToHttpApiData (SigmacordToken a) where
+  toUrlPiece = unToken
+
+type InteractionToken = SigmacordToken InteractionIdType
+
+type WebhookToken = SigmacordToken WebhookIdType
+
+type Shard = (Int, Int)
+
+
+snowflakeCreationDate :: Snowflake -> UTCTime
+snowflakeCreationDate x = posixSecondsToUTCTime . realToFrac
+  $ 1420070400 + quot (shiftR x 22) 1000
+
+
+epochTime :: UTCTime
+epochTime = posixSecondsToUTCTime 0
+
+{-
+
+InternalSigmacordEnum is a hack-y typeclass, but it's the best solution overall.
+The best we can do is prevent the end-user from seeing this.
+
+typeclass Bounded (minBound + maxBound) could replace SigmacordTypeStartValue, but
+it can't derive instances for types like SigmacordColor, which have simple sum types involved.
+
+typeclass Enum (toEnum + fromEnum) requires defining both A->Int and Int->A.
+If we handle both at once (with an inline map), it's no longer typesafe.
+
+External packages exist, but bloat our dependencies
+
+-}
+class Data a => InternalSigmacordEnum a where
+  SigmacordTypeStartValue :: a
+  fromSigmacordType :: a -> Int
+  SigmacordTypeTable :: [(Int, a)]
+  SigmacordTypeTable =  map (\d -> (fromSigmacordType d, d)) (makeTable SigmacordTypeStartValue)
+    where
+      makeTable :: Data b => b -> [b]
+      makeTable t = map fromConstr (dataTypeConstrs $ dataTypeOf t)
+
+  SigmacordTypeParseJSON :: String -> Value -> Parser a
+  SigmacordTypeParseJSON name =
+    withScientific
+      name
+      ( \i -> do
+          case maybeInt i >>= (`lookup` SigmacordTypeTable) of
+            Nothing -> fail $ "could not parse type: " ++ show i
+            Just d -> return d
+      )
+    where
+      maybeInt i
+        | fromIntegral (round i) == i = Just $ round i
+        | otherwise = Nothing
+
+
+
+
+
+
+#if MIN_VERSION_aeson(2, 0, 0)
+type AesonKey = Key.Key
+#else
+type AesonKey = T.Text
+#endif
+
+
+(.==) :: ToJSON a => AesonKey -> a -> Maybe Pair
+k .== v = Just (k .= v)
+
+(.=?) :: ToJSON a => AesonKey -> Maybe a -> Maybe Pair
+k .=? (Just v) = Just (k .= v)
+_ .=? Nothing = Nothing
+
+objectFromMaybes :: [Maybe Pair] -> Value
+objectFromMaybes = object . catMaybes
+
+
+
+
+
+
+
+
+data Base64Image a = Base64Image T.Text T.Text
+  deriving (Show, Read, Eq, Ord)
+
+
+
+
+
+instance ToJSON (Base64Image a) where
+  toJSON (Base64Image mime im) = String $ "data:" <> mime <> ";base64," <> im
+
+
+
+
+
+
+
+
+
+
+
+
+getMimeType :: B.ByteString -> Maybe T.Text
+getMimeType bs
+  | B.take 8 bs == "\x89\x50\x4E\x47\x0D\x0A\x1A\x0A"
+  = Just "image/png"
+  | B.take 3 bs == "\xff\xd8\xff" || B.take 4 (B.drop 6 bs) `elem` ["JFIF", "Exif"]
+  = Just "image/jpeg"
+  | B.take 6 bs == "\x47\x49\x46\x38\x37\x61" || B.take 6 bs == "\x47\x49\x46\x38\x39\x61"
+  = Just "image/gif"
+  | B.take 4 bs == "RIFF" && B.take 4 (B.drop 8 bs) == "WEBP"
+  = Just "image/webp"
+  | otherwise = Nothing
+
+
+
+
+data ChannelTypeOption
+  = 
+    ChannelTypeOptionGuildText
+  | 
+    ChannelTypeOptionDM
+  | 
+    ChannelTypeOptionGuildVoice
+  | 
+    ChannelTypeOptionGroupDM
+  | 
+    ChannelTypeOptionGuildCategory
+  | 
+    ChannelTypeOptionGuildNews
+  | 
+    ChannelTypeOptionGuildStore
+  | 
+    ChannelTypeOptionGuildNewsThread
+  | 
+    ChannelTypeOptionGuildPublicThread
+  | 
+    
+    ChannelTypeOptionGuildPrivateThread
+  | 
+    ChannelTypeOptionGuildStageVoice
+  deriving (Show, Read, Data, Eq, Ord)
+
+instance InternalSigmacordEnum ChannelTypeOption where
+  SigmacordTypeStartValue = ChannelTypeOptionGuildText
+  fromSigmacordType ChannelTypeOptionGuildText = 0
+  fromSigmacordType ChannelTypeOptionDM = 1
+  fromSigmacordType ChannelTypeOptionGuildVoice = 2
+  fromSigmacordType ChannelTypeOptionGroupDM = 3
+  fromSigmacordType ChannelTypeOptionGuildCategory = 4
+  fromSigmacordType ChannelTypeOptionGuildNews = 5
+  fromSigmacordType ChannelTypeOptionGuildStore = 6
+  fromSigmacordType ChannelTypeOptionGuildNewsThread = 10
+  fromSigmacordType ChannelTypeOptionGuildPublicThread = 11
+  fromSigmacordType ChannelTypeOptionGuildPrivateThread = 12
+  fromSigmacordType ChannelTypeOptionGuildStageVoice = 13
+
+instance ToJSON ChannelTypeOption where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON ChannelTypeOption where
+  parseJSON = SigmacordTypeParseJSON "ChannelTypeOption"

+ src/Sigmacord/Internal/Types/RolePermissions.hs view
@@ -0,0 +1,119 @@+module Sigmacord.Internal.Types.RolePermissions
+  ( PermissionFlag (..),
+    hasRolePermissions,
+    hasRolePermission,
+    newRolePermissions,
+    newRolePermission,
+    setRolePermissions,
+    setRolePermission,
+    clearRolePermissions,
+    clearRolePermission,
+    hasGuildMemberPermission,
+  )
+where
+
+import Data.Bits (Bits (complement, shift, (.&.), (.|.)))
+import Sigmacord.Internal.Types.Guild
+  ( Guild,
+    Role (rolePerms),
+    roleIdToRole,
+  )
+import Sigmacord.Internal.Types.Prelude (RolePermissions)
+import Sigmacord.Internal.Types.User (GuildMember (memberRoles))
+
+data PermissionFlag
+  = CREATE_INSTANT_INVITE
+  | KICK_MEMBERS
+  | BAN_MEMBERS
+  | ADMINISTRATOR
+  | MANAGE_CHANNELS
+  | MANAGE_GUILD
+  | ADD_REACTIONS
+  | VIEW_AUDIT_LOG
+  | PRIORITY_SPEAKER
+  | STREAM
+  | VIEW_CHANNEL
+  | SEND_MESSAGES
+  | SEND_TTS_MESSAGES
+  | MANAGE_MESSAGES
+  | EMBED_LINKS
+  | ATTACH_FILES
+  | READ_MESSAGE_HISTORY
+  | MENTION_EVERYONE
+  | USE_EXTERNAL_EMOJIS
+  | VIEW_GUILD_INSIGHT
+  | CONNECT
+  | SPEAK
+  | MUTE_MEMBERS
+  | DEAFEN_MEMBERS
+  | MOVE_MEMBERS
+  | USE_VAD
+  | CHANGE_NICKNAME
+  | MANAGE_NICKNAMES
+  | MANAGE_ROLES
+  | MANAGE_WEBHOOKS
+  | MANAGE_EMOJIS_AND_STICKERS
+  | USE_APPLICATION_COMMANDS
+  | REQUEST_TO_SPEAK
+  | MANAGE_EVENTS
+  | MANAGE_THREADS
+  | CREATE_PUBLIC_THREADS
+  | CREATE_PRIVATE_THREADS
+  | USE_EXTERNAL_STICKERS
+  | SEND_MESSAGES_IN_THREADS
+  | USE_EMBEDDED_ACTIVITIES
+  | MODERATE_MEMBERS
+  deriving (Eq, Ord, Enum, Show)
+
+permissionBits :: PermissionFlag -> RolePermissions
+permissionBits p = shift 1 (fromEnum p)
+
+
+hasRolePermissions :: [PermissionFlag] -> RolePermissions -> Bool
+hasRolePermissions permissions rolePermissions = (.&.) combinedPermissions rolePermissions == combinedPermissions
+  where
+    combinedPermissions = combinePermissions permissions
+
+
+hasRolePermission :: PermissionFlag -> RolePermissions -> Bool
+hasRolePermission p r = (.&.) (permissionBits p) r > 0
+
+
+
+newRolePermissions :: [PermissionFlag] -> RolePermissions
+newRolePermissions = combinePermissions
+
+
+newRolePermission :: PermissionFlag -> RolePermissions
+newRolePermission = permissionBits
+
+
+setRolePermissions :: [PermissionFlag] -> RolePermissions -> RolePermissions
+setRolePermissions p r = combinePermissions p .|. r
+
+
+clearRolePermissions :: [PermissionFlag] -> RolePermissions -> RolePermissions
+clearRolePermissions p r = (complement . combinePermissions) p .&. r
+
+
+
+setRolePermission :: PermissionFlag -> RolePermissions -> RolePermissions
+setRolePermission p = (.|.) (permissionBits p)
+
+
+clearRolePermission :: PermissionFlag -> RolePermissions -> RolePermissions
+clearRolePermission p = (.&.) (complement . permissionBits $ p)
+
+combinePermissions :: [PermissionFlag] -> RolePermissions
+combinePermissions = foldr ((.|.) . permissionBits) 0
+
+
+
+
+hasGuildMemberPermission :: Guild -> GuildMember -> PermissionFlag -> Bool
+hasGuildMemberPermission g gm p = go (memberRoles gm)
+  where
+    go [] = False
+    go (x : xs) = case roleIdToRole g x of
+      Nothing -> go xs
+      Just a -> p `hasRolePermission` rolePerms a || go xs

+ src/Sigmacord/Internal/Types/ScheduledEvents.hs view
@@ -0,0 +1,536 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+
+module Sigmacord.Internal.Types.ScheduledEvents where
+
+import           Data.Aeson                     ( (.:)
+                                                , (.:!)
+                                                , (.:?)
+                                                , (.=)
+                                                , FromJSON(parseJSON)
+                                                , ToJSON(toJSON)
+                                                , Value(Null, Number, String)
+                                                , object
+                                                , withObject
+                                                , withText
+                                                )
+import           Data.Aeson.Types               ( Parser )
+import qualified Data.ByteString               as B
+import           Data.Data                      ( Data )
+import           Data.Default                   ( Default(def) )
+import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as T
+import           Data.Time                      ( UTCTime )
+import           Sigmacord.Internal.Types.Prelude ( ChannelId
+                                                , GuildId
+                                                , InternalSigmacordEnum
+                                                  ( SigmacordTypeParseJSON
+                                                  , SigmacordTypeStartValue
+                                                  , fromSigmacordType
+                                                  )
+                                                , ScheduledEventEntityId
+                                                , ScheduledEventId
+                                                , UserId
+                                                , (.==)
+                                                , (.=?)
+                                                , objectFromMaybes
+                                                )
+import           Sigmacord.Internal.Types.User    ( GuildMember
+                                                , User
+                                                )
+
+
+
+
+data ScheduledEvent
+  = ScheduledEventStage
+      { scheduledEventStageId :: ScheduledEventId
+      , scheduledEventStageGuildId :: GuildId
+      , scheduledEventStageChannelId :: ChannelId
+      , scheduledEventStageCreatorId :: Maybe UserId
+      , scheduledEventStageName :: T.Text
+      , scheduledEventStageDescription :: Maybe T.Text
+      , scheduledEventStageStartTime :: UTCTime
+      , scheduledEventStageEndTime :: Maybe UTCTime
+      , scheduledEventStagePrivacyLevel :: ScheduledEventPrivacyLevel
+      , scheduledEventStageStatus :: ScheduledEventStatus
+      , scheduledEventStageEntityId :: Maybe ScheduledEventEntityId
+      , scheduledEventStageCreator :: Maybe User
+      , scheduledEventStageUserCount :: Maybe Integer
+      , scheduledEventStageImage :: Maybe ScheduledEventImageHash
+      }
+  | ScheduledEventVoice
+      { scheduledEventVoiceId :: ScheduledEventId
+      , scheduledEventVoiceGuildId :: GuildId
+      , scheduledEventVoiceChannelId :: ChannelId
+      , scheduledEventVoiceCreatorId :: Maybe UserId
+      , scheduledEventVoiceName :: T.Text
+      , scheduledEventVoiceDescription :: Maybe T.Text
+      , scheduledEventVoiceStartTime :: UTCTime
+      , scheduledEventVoiceEndTime :: Maybe UTCTime
+      , scheduledEventVoicePrivacyLevel :: ScheduledEventPrivacyLevel
+      , scheduledEventVoiceStatus :: ScheduledEventStatus
+      , scheduledEventVoiceEntityId :: Maybe ScheduledEventEntityId
+      , scheduledEventVoiceCreator :: Maybe User
+      , scheduledEventVoiceUserCount :: Maybe Integer
+      , scheduledEventVoiceImage :: Maybe ScheduledEventImageHash
+      }
+  | ScheduledEventExternal
+      { scheduledEventExternalId :: ScheduledEventId
+      , scheduledEventExternalGuildId :: GuildId
+      , scheduledEventExternalLocation :: T.Text
+      , scheduledEventExternalCreatorId :: Maybe UserId
+      , scheduledEventExternalName :: T.Text
+      , scheduledEventExternalDescription :: Maybe T.Text
+      , scheduledEventExternalStartTime :: UTCTime
+      , scheduledEventExternalEndTime :: UTCTime
+      , scheduledEventExternalPrivacyLevel :: ScheduledEventPrivacyLevel
+      , scheduledEventExternalStatus :: ScheduledEventStatus
+      , scheduledEventExternalEntityId :: Maybe ScheduledEventEntityId
+      , scheduledEventExternalCreator :: Maybe User
+      , scheduledEventExternalUserCount :: Maybe Integer
+      , scheduledEventExternalImage :: Maybe ScheduledEventImageHash
+      }
+  deriving (Show, Eq, Read)
+
+instance ToJSON ScheduledEvent where
+  toJSON ScheduledEventStage {..} = objectFromMaybes
+      [ "id"                   .== scheduledEventStageId
+      , "guild_id"             .== scheduledEventStageGuildId
+      , "channel_id"           .== scheduledEventStageChannelId
+      , "creator_id"           .=? scheduledEventStageCreatorId
+      , "name"                 .== scheduledEventStageName
+      , "description"          .=? scheduledEventStageDescription
+      , "scheduled_start_time" .== scheduledEventStageStartTime
+      , "scheduled_end_time"   .=? scheduledEventStageEndTime
+      , "privacy_level"        .== scheduledEventStagePrivacyLevel
+      , "entity_type"          .== Number 1
+      , "entity_id"            .=? scheduledEventStageEntityId
+      , "creator"              .=? scheduledEventStageCreator
+      , "user_count"           .=? scheduledEventStageUserCount
+      , "image"                .=? scheduledEventStageImage
+      ]
+  toJSON ScheduledEventVoice {..} = objectFromMaybes
+      [ "id"                   .== scheduledEventVoiceId
+      , "guild_id"             .== scheduledEventVoiceGuildId
+      , "channel_id"           .== scheduledEventVoiceChannelId
+      , "creator_id"           .=? scheduledEventVoiceCreatorId
+      , "name"                 .== scheduledEventVoiceName
+      , "description"          .=? scheduledEventVoiceDescription
+      , "scheduled_start_time" .== scheduledEventVoiceStartTime
+      , "scheduled_end_time"   .=? scheduledEventVoiceEndTime
+      , "privacy_level"        .== scheduledEventVoicePrivacyLevel
+      , "entity_type"          .== Number 2
+      , "entity_id"            .=? scheduledEventVoiceEntityId
+      , "creator"              .=? scheduledEventVoiceCreator
+      , "user_count"           .=? scheduledEventVoiceUserCount
+      , "image"                .=? scheduledEventVoiceImage
+      ]
+  toJSON ScheduledEventExternal {..} = objectFromMaybes
+      [ "id"                   .== scheduledEventExternalId
+      , "guild_id"             .== scheduledEventExternalGuildId
+      , "creator_id"           .=? scheduledEventExternalCreatorId
+      , "name"                 .== scheduledEventExternalName
+      , "description"          .=? scheduledEventExternalDescription
+      , "scheduled_start_time" .== scheduledEventExternalStartTime
+      , "scheduled_end_time"   .== scheduledEventExternalEndTime
+      , "privacy_level"        .== scheduledEventExternalPrivacyLevel
+      , "entity_type"          .== Number 3
+      , "entity_id"            .=? scheduledEventExternalEntityId
+      , "creator"              .=? scheduledEventExternalCreator
+      , "user_count"           .=? scheduledEventExternalUserCount
+      , "image"                .=? scheduledEventExternalImage
+      , "entity_metadata"
+         .== object ["location" .= toJSON scheduledEventExternalLocation]
+      ]
+
+
+instance FromJSON ScheduledEvent where
+  parseJSON = withObject
+    "ScheduledEvent"
+    (\v -> do
+      setype <- v .: "entity_type" :: Parser Int
+      seid   <- v .: "id"
+      segid  <- v .: "guild_id"
+      secrid <- v .:? "creator_id"
+      sename <- v .: "name"
+      sedesc <- v .:? "description"
+      sest   <- v .: "scheduled_start_time"
+      sepl   <- v .: "privacy_level" :: Parser ScheduledEventPrivacyLevel
+      sestat <- v .: "status" :: Parser ScheduledEventStatus
+      seeid  <- v .:? "entity_id"
+      secrea <- v .:? "creator"
+      seuc   <- v .:? "user_count"
+      seim   <- v .:? "image"
+
+      case setype of
+        1 -> do
+          sechid <- v .: "channelId"
+          seet   <- v .:? "scheduled_end_time"
+          return $ ScheduledEventStage seid
+                                       segid
+                                       sechid
+                                       secrid
+                                       sename
+                                       sedesc
+                                       sest
+                                       seet
+                                       sepl
+                                       sestat
+                                       seeid
+                                       secrea
+                                       seuc
+                                       seim
+        2 -> do
+          sechid <- v .: "channelId"
+          seet   <- v .:? "scheduled_end_time"
+          return $ ScheduledEventVoice seid
+                                       segid
+                                       sechid
+                                       secrid
+                                       sename
+                                       sedesc
+                                       sest
+                                       seet
+                                       sepl
+                                       sestat
+                                       seeid
+                                       secrea
+                                       seuc
+                                       seim
+        3 -> do
+          semeta <- v .: "entity_metadata"
+          seloc  <- withObject "entity_metadata" (.: "location") semeta
+          seet   <- v .: "scheduled_end_time"
+          return $ ScheduledEventExternal seid
+                                          segid
+                                          seloc
+                                          secrid
+                                          sename
+                                          sedesc
+                                          sest
+                                          seet
+                                          sepl
+                                          sestat
+                                          seeid
+                                          secrea
+                                          seuc
+                                          seim
+        _ -> error "unreachable"
+    )
+
+
+data ScheduledEventPrivacyLevel = ScheduledEventPrivacyLevelGuildOnly
+  deriving (Show, Read, Eq, Ord, Data)
+
+instance InternalSigmacordEnum ScheduledEventPrivacyLevel where
+  SigmacordTypeStartValue = ScheduledEventPrivacyLevelGuildOnly
+  fromSigmacordType ScheduledEventPrivacyLevelGuildOnly = 2
+
+instance ToJSON ScheduledEventPrivacyLevel where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON ScheduledEventPrivacyLevel where
+  parseJSON = SigmacordTypeParseJSON "ScheduledEventPrivacyLevel"
+
+
+data ScheduledEventStatus
+  = ScheduledEventStatusScheduled
+  | ScheduledEventStatusActive
+  | ScheduledEventStatusCompleted
+  | ScheduledEventStatusCancelled
+  deriving (Show, Read, Eq, Ord, Data)
+
+instance InternalSigmacordEnum ScheduledEventStatus where
+  SigmacordTypeStartValue = ScheduledEventStatusScheduled
+  fromSigmacordType ScheduledEventStatusScheduled = 1
+  fromSigmacordType ScheduledEventStatusActive    = 2
+  fromSigmacordType ScheduledEventStatusCompleted = 3
+  fromSigmacordType ScheduledEventStatusCancelled = 4
+
+instance ToJSON ScheduledEventStatus where
+  toJSON = toJSON . fromSigmacordType
+
+instance FromJSON ScheduledEventStatus where
+  parseJSON = SigmacordTypeParseJSON "ScheduledEventStatus"
+
+
+type ScheduledEventImageHash = T.Text
+
+
+data CreateScheduledEventImageUploadType
+  = CreateScheduledEventImageUploadTypeJPG
+  | CreateScheduledEventImageUploadTypePNG
+  | CreateScheduledEventImageUploadTypeGIF
+  deriving (Show, Read, Eq, Ord)
+
+
+data CreateScheduledEventImage
+  = CreateScheduledEventImageURL T.Text
+  | CreateScheduledEventImageUpload CreateScheduledEventImageUploadType B.ByteString
+  deriving (Show, Read, Eq, Ord)
+
+instance ToJSON CreateScheduledEventImage where
+  toJSON (CreateScheduledEventImageURL u) = String u
+  toJSON (CreateScheduledEventImageUpload typ bs) =
+    String
+      $  "data:"
+      <> (case typ of
+           CreateScheduledEventImageUploadTypeJPG -> "image/jpeg"
+           CreateScheduledEventImageUploadTypePNG -> "image/png"
+           CreateScheduledEventImageUploadTypeGIF -> "image/gif"
+         )
+      <> ";base64,"
+      <> T.decodeUtf8 bs
+
+instance FromJSON CreateScheduledEventImage where
+  parseJSON =
+    withText "CreateScheduledEventImage" (return . CreateScheduledEventImageURL)
+
+
+data CreateScheduledEventData
+  = CreateScheduledEventDataStage
+      { createScheduleEventDataStageChannelId :: ChannelId
+      , createScheduleEventDataStageName :: T.Text
+      , createScheduleEventDataStagePrivacyLevel :: ScheduledEventPrivacyLevel
+      , createScheduleEventDataStageStartTime :: UTCTime
+      , createScheduleEventDataStageEndTime :: Maybe UTCTime
+      , createScheduleEventDataStageDescription :: Maybe T.Text
+      , createScheduleEventDataStageImage :: Maybe CreateScheduledEventImage
+      }
+  | CreateScheduledEventDataVoice
+      { createScheduleEventDataVoiceChannelId :: ChannelId
+      , createScheduleEventDataVoiceName :: T.Text
+      , createScheduleEventDataVoicePrivacyLevel :: ScheduledEventPrivacyLevel
+      , createScheduleEventDataVoiceStartTime :: UTCTime
+      , createScheduleEventDataVoiceEndTime :: Maybe UTCTime
+      , createScheduleEventDataVoiceDescription :: Maybe T.Text
+      , createScheduleEventDataVoiceImage :: Maybe CreateScheduledEventImage
+      }
+  | CreateScheduledEventDataExternal
+      { createScheduleEventDataExternalLocation :: T.Text
+      , createScheduleEventDataExternalName :: T.Text
+      , createScheduleEventDataExternalPrivacyLevel :: ScheduledEventPrivacyLevel
+      , createScheduleEventDataExternalStartTime :: UTCTime
+      , createScheduleEventDataExternalEndTime :: UTCTime
+      , createScheduleEventDataExternalDescription :: Maybe T.Text
+      , createScheduleEventDataExternalImage :: Maybe CreateScheduledEventImage
+      }
+
+instance ToJSON CreateScheduledEventData where
+  toJSON CreateScheduledEventDataStage {..} = objectFromMaybes
+      [ "channel_id"           .== createScheduleEventDataStageChannelId
+      , "name"                 .== createScheduleEventDataStageName
+      , "privacy_level"        .== createScheduleEventDataStagePrivacyLevel
+      , "scheduled_start_time" .== createScheduleEventDataStageStartTime
+      , "scheduled_end_time"   .=? createScheduleEventDataStageEndTime
+      , "description"          .=? createScheduleEventDataStageDescription
+      , "entity_type"          .== Number 1
+      , "image"                .=? createScheduleEventDataStageImage
+      ]
+  toJSON CreateScheduledEventDataVoice {..} = objectFromMaybes
+      [ "channel_id"           .== createScheduleEventDataVoiceChannelId
+      , "name"                 .== createScheduleEventDataVoiceName
+      , "privacy_level"        .== createScheduleEventDataVoicePrivacyLevel
+      , "scheduled_start_time" .== createScheduleEventDataVoiceStartTime
+      , "scheduled_end_time"   .=? createScheduleEventDataVoiceEndTime
+      , "description"          .=? createScheduleEventDataVoiceDescription
+      , "entity_type"          .== Number 2
+      , "image"                .=? createScheduleEventDataVoiceImage
+      ]
+  toJSON CreateScheduledEventDataExternal {..} = objectFromMaybes
+      [ "entity_metadata"
+         .== object ["location" .= createScheduleEventDataExternalLocation]
+      , "name"                 .== createScheduleEventDataExternalName
+      , "privacy_level"        .== createScheduleEventDataExternalPrivacyLevel
+      , "scheduled_start_time" .== createScheduleEventDataExternalStartTime
+      , "scheduled_end_time"   .== createScheduleEventDataExternalEndTime
+      , "description"          .=? createScheduleEventDataExternalDescription
+      , "entity_type"          .== Number 2
+      , "image"                .=? createScheduleEventDataExternalImage
+      ]
+
+instance FromJSON CreateScheduledEventData where
+  parseJSON = withObject
+    "CreateScheduledEventData"
+    (\v -> do
+      t       <- v .: "entity_type" :: Parser Int
+      csename <- v .: "name"
+      csepl   <- v .: "privacy_level"
+      csest   <- v .: "scheduled_start_time"
+      csedesc <- v .:? "description"
+      cseimg  <- v .:? "image"
+
+      case t of
+        1 -> do
+          csecid <- v .: "channel_id"
+          cseet  <- v .:? "scheduled_end_time"
+          return $ CreateScheduledEventDataStage csecid
+                                                 csename
+                                                 csepl
+                                                 csest
+                                                 cseet
+                                                 csedesc
+                                                 cseimg
+        2 -> do
+          csecid <- v .: "channel_id"
+          cseet  <- v .:? "scheduled_end_time"
+          return $ CreateScheduledEventDataVoice csecid
+                                                 csename
+                                                 csepl
+                                                 csest
+                                                 cseet
+                                                 csedesc
+                                                 cseimg
+        3 -> do
+          csemeta <- v .: "entity_metadata"
+          cseloc  <- withObject "entity_metadata" (.: "location") csemeta
+          cseet   <- v .: "scheduled_end_time"
+          return $ CreateScheduledEventDataVoice cseloc
+                                                 csename
+                                                 csepl
+                                                 csest
+                                                 cseet
+                                                 csedesc
+                                                 cseimg
+        _ -> error "unreachable"
+    )
+
+
+
+data ScheduledEventType
+  = ScheduledEventTypeStage
+  | ScheduledEventTypeVoice
+  | ScheduledEventTypeExternal
+  deriving (Show, Read, Ord, Eq, Data)
+
+instance InternalSigmacordEnum ScheduledEventType where
+  SigmacordTypeStartValue = ScheduledEventTypeStage
+  fromSigmacordType ScheduledEventTypeStage    = 1
+  fromSigmacordType ScheduledEventTypeVoice    = 2
+  fromSigmacordType ScheduledEventTypeExternal = 3
+
+instance FromJSON ScheduledEventType where
+  parseJSON = SigmacordTypeParseJSON "ScheduledEventType"
+
+instance ToJSON ScheduledEventType where
+  toJSON = toJSON . fromSigmacordType
+
+
+
+
+data ModifyScheduledEventData = ModifyScheduledEventData
+  { modifyScheduledEventDataChannelId    :: Maybe (Maybe ChannelId)
+  , modifyScheduledEventDataLocation     :: Maybe (Maybe T.Text)
+  , modifyScheduledEventDataName         :: Maybe T.Text
+  , modifyScheduledEventDataPrivacyLevel :: Maybe ScheduledEventPrivacyLevel
+  , modifyScheduledEventDataStartTime    :: Maybe UTCTime
+  , modifyScheduledEventDataEndTime      :: Maybe UTCTime
+  , modifyScheduledEventDataDescription  :: Maybe (Maybe T.Text)
+  , modifyScheduledEventDataType         :: Maybe ScheduledEventType
+  , modifyScheduledEventDataStatus       :: Maybe ScheduledEventStatus
+  , modifyScheduledEventDataImage        :: Maybe CreateScheduledEventImage
+  }
+
+instance Default ModifyScheduledEventData where
+  def = ModifyScheduledEventData Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+
+instance ToJSON ModifyScheduledEventData where
+  toJSON ModifyScheduledEventData {..} = objectFromMaybes
+      [ "channel_id"           .=? modifyScheduledEventDataChannelId
+      , "entity_metadata"      .=? loc
+      , "name"                 .=? modifyScheduledEventDataName
+      , "scheduled_start_time" .=? modifyScheduledEventDataStartTime
+      , "scheduled_end_time"   .=? modifyScheduledEventDataEndTime
+      , "description"          .=? modifyScheduledEventDataDescription
+      , "entity_type"          .=? modifyScheduledEventDataType
+      , "status"               .=? modifyScheduledEventDataStatus
+      , "image"                .=? modifyScheduledEventDataImage
+      ]
+   where
+    loc = case modifyScheduledEventDataLocation of
+      Nothing      -> Nothing
+      Just Nothing -> Just Null
+      Just loc'    -> Just $ object [("location", toJSON loc')]
+
+instance FromJSON ModifyScheduledEventData where
+  parseJSON = withObject
+    "ModifyScheduledEventData"
+    (\v -> do
+      
+      msename  <- v .:? "name"
+      msest    <- v .:? "scheduled_start_time"
+      mseet    <- v .:? "scheduled_end_time"
+      msetype  <- v .:? "entity_type"
+      msepl    <- v .:? "privacy_level"
+      msestat  <- v .:? "status"
+      mseimg   <- v .:? "image"
+
+      
+      msecid'  <- v .:! "channel_id"
+      mseloc'  <- v .:! "entity_metadata"
+      msedesc' <- v .:! "description"
+
+      
+      msecid   <- case msecid' of
+        Nothing   -> return Nothing
+        Just Null -> return $ Just Nothing
+        Just x    -> do
+          x' <- parseJSON x
+          return $ Just x'
+
+      mseloc <- case mseloc' of
+        Nothing   -> return Nothing
+        Just Null -> return $ Just Nothing
+        Just x    -> do
+          x' <- withObject "entity_metadata" (.: "location") x
+          return $ Just x'
+
+      msedesc <- case msedesc' of
+        Nothing   -> return Nothing
+        Just Null -> return $ Just Nothing
+        Just x    -> do
+          x' <- parseJSON x
+          return $ Just x'
+
+      return $ ModifyScheduledEventData
+        { modifyScheduledEventDataChannelId    = msecid
+        , modifyScheduledEventDataLocation     = mseloc
+        , modifyScheduledEventDataName         = msename
+        , modifyScheduledEventDataPrivacyLevel = msepl
+        , modifyScheduledEventDataStartTime    = msest
+        , modifyScheduledEventDataEndTime      = mseet
+        , modifyScheduledEventDataDescription  = msedesc
+        , modifyScheduledEventDataType         = msetype
+        , modifyScheduledEventDataStatus       = msestat
+        , modifyScheduledEventDataImage        = mseimg
+        }
+    )
+
+
+data ScheduledEventUser = ScheduledEventUser
+  { scheduledEventUserEvent       :: ScheduledEventId
+  , scheduledEventUserUser        :: User
+  , scheduledEventUserGuildMember :: Maybe GuildMember
+  }
+
+instance FromJSON ScheduledEventUser where
+  parseJSON = withObject
+    "ScheduledEventUser"
+    (\v ->
+      ScheduledEventUser
+        <$> v .:  "guild_scheduled_event_id"
+        <*> v .:  "user"
+        <*> v .:? "member"
+    )

+ src/Sigmacord/Internal/Types/User.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+
+module Sigmacord.Internal.Types.User where
+
+import Data.Aeson
+import Data.Text (Text)
+import qualified Data.Text as T
+import Sigmacord.Internal.Types.Prelude
+import Data.Time (UTCTime)
+
+
+data User = User
+  { userId          :: UserId             
+  , userName        :: T.Text             
+  , userDiscrim     :: Maybe T.Text       
+  , userGlobalName  :: Maybe T.Text       
+  , userAvatar      :: Maybe T.Text       
+  , userIsBot       :: Bool               
+  , userIsWebhook   :: Bool               
+  , userIsSystem    :: Maybe Bool         
+  , userMfa         :: Maybe Bool         
+  , userBanner      :: Maybe T.Text       
+  , userAccentColor :: Maybe Int          
+  , userLocale      :: Maybe T.Text       
+  , userVerified    :: Maybe Bool         
+  , userEmail       :: Maybe T.Text       
+  , userFlags       :: Maybe Integer      
+  , userPremiumType :: Maybe Integer      
+  , userPublicFlags :: Maybe Integer      
+  , userMember      :: Maybe GuildMember  
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON User where
+  parseJSON = withObject "User" $ \o ->
+    User <$> o .:  "id"
+         <*> o .:  "username"
+         <*> o .:? "discriminator" 
+         <*> o .:? "global_name"
+         <*> o .:? "avatar"
+         <*> o .:? "bot" .!= False
+         <*> pure False 
+         <*> o .:? "system"
+         <*> o .:? "mfa_enabled"
+         <*> o .:? "banner"
+         <*> o .:? "accent_color"
+         <*> o .:? "locale"
+         <*> o .:? "verified"
+         <*> o .:? "email"
+         <*> o .:? "flags"
+         <*> o .:? "premium_type"
+         <*> o .:? "public_flags"
+         <*> o .:? "member"
+
+instance ToJSON User where
+  toJSON User{..} = objectFromMaybes
+              [ "id" .== userId
+              , "username" .== userName
+              , "discriminator" .=? userDiscrim
+              , "global_name" .=? userGlobalName
+              , "avatar" .=? userAvatar
+              , "bot" .== userIsBot
+              , "system" .=? userIsSystem
+              , "mfa_enabled" .=? userMfa
+              , "banner" .=? userBanner
+              , "accent_color" .=? userAccentColor
+              , "verified" .=? userVerified
+              , "email" .=? userEmail
+              , "flags" .=? userFlags
+              , "premium_type" .=? userPremiumType
+              , "public_flags" .=? userPublicFlags
+              , "member" .=? userPublicFlags
+              ]
+
+
+data Webhook = Webhook
+  { webhookId :: WebhookId
+  , webhookToken :: Maybe WebhookToken
+  , webhookChannelId :: ChannelId
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON Webhook where
+  parseJSON = withObject "Webhook" $ \o ->
+    Webhook <$> o .:  "id"
+            <*> o .:? "token"
+            <*> o .:  "channel_id"
+
+
+data ConnectionObject = ConnectionObject
+  { connectionObjectId :: Text 
+  , connectionObjectName :: Text 
+  , connectionObjectType :: Text 
+  , connectionObjectRevoked :: Bool 
+  , connectionObjectIntegrations :: [IntegrationId] 
+  , connectionObjectVerified :: Bool 
+  , connectionObjectFriendSyncOn :: Bool 
+  , connectionObjectShownInPresenceUpdates :: Bool 
+  , connectionObjectVisibleToOthers :: Bool 
+  } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON ConnectionObject where
+  parseJSON = withObject "ConnectionObject" $ \o -> do
+    integrations <- o .: "integrations"
+    ConnectionObject <$> o .: "id"
+               <*> o .: "name"
+               <*> o .: "type"
+               <*> o .: "revoked"
+               <*> mapM (.: "id") integrations
+               <*> o .: "verified"
+               <*> o .: "friend_sync"
+               <*> o .: "show_activity"
+               <*> ( (==) (1::Int) <$> o .: "visibility")
+
+
+
+data GuildMember = GuildMember
+      { memberUser     :: Maybe User 
+      , memberNick     :: Maybe T.Text 
+      , memberAvatar   :: Maybe T.Text 
+      , memberRoles    :: [RoleId] 
+      , memberJoinedAt :: UTCTime 
+      , memberPremiumSince :: Maybe UTCTime 
+      , memberDeaf     :: Bool 
+      , memberMute     :: Bool 
+      , memberPending     :: Bool 
+      , memberPermissions     :: Maybe T.Text 
+      , memberTimeoutEnd :: Maybe UTCTime 
+      } deriving (Show, Read, Eq, Ord)
+
+instance FromJSON GuildMember where
+  parseJSON = withObject "GuildMember" $ \o ->
+    GuildMember <$> o .:? "user"
+                <*> o .:? "nick"
+                <*> o .:? "avatar"
+                <*> o .:  "roles"
+                <*> o .:  "joined_at"
+                <*> o .:? "premium_since"
+                <*> o .:  "deaf"
+                <*> o .:  "mute"
+                <*> o .:? "pending" .!= False
+                <*> o .:? "permissions"
+                <*> o .:? "communication_disabled_until"
+
+instance ToJSON GuildMember where
+  toJSON GuildMember {..} = objectFromMaybes
+      [ "user" .=? memberUser
+      , "nick" .=? memberNick
+      , "avatar" .=? memberAvatar
+      , "roles" .== memberRoles
+      , "joined_at" .== memberJoinedAt
+      , "premium_since" .=? memberPremiumSince
+      , "deaf" .== memberDeaf
+      , "mute" .== memberMute
+      , "pending" .== memberPending
+      , "permissions" .=? memberPermissions
+      , "communication_disabled_until" .=? memberTimeoutEnd
+      ]

+ src/Sigmacord/Requests.hs view
@@ -0,0 +1,23 @@+module Sigmacord.Requests
+  ( module Sigmacord.Internal.Rest.Channel
+  , module Sigmacord.Internal.Rest.Emoji
+  , module Sigmacord.Internal.Rest.Guild
+  , module Sigmacord.Internal.Rest.Invite
+  , module Sigmacord.Internal.Rest.User
+  , module Sigmacord.Internal.Rest.Voice
+  , module Sigmacord.Internal.Rest.Webhook
+  , module Sigmacord.Internal.Rest.ApplicationCommands
+  , module Sigmacord.Internal.Rest.Interactions
+  , module Sigmacord.Internal.Rest.ScheduledEvents
+  ) where
+
+import Sigmacord.Internal.Rest.Channel
+import Sigmacord.Internal.Rest.Emoji
+import Sigmacord.Internal.Rest.Guild
+import Sigmacord.Internal.Rest.Invite
+import Sigmacord.Internal.Rest.User
+import Sigmacord.Internal.Rest.Voice
+import Sigmacord.Internal.Rest.Webhook
+import Sigmacord.Internal.Rest.ApplicationCommands
+import Sigmacord.Internal.Rest.Interactions
+import Sigmacord.Internal.Rest.ScheduledEvents

+ src/Sigmacord/Types.hs view
@@ -0,0 +1,15 @@+module Sigmacord.Types
+  ( module Sigmacord.Internal.Types
+  ) where
+
+import Sigmacord.Internal.Types hiding
+    ( GatewaySendableInternal(..)
+    , GatewayReceivable(..)
+    , EventInternalParse(..)
+    , InternalSigmacordEnum(..)
+    , Base64Image(..)
+
+    , colorToInternal
+    , convertToRGB
+    , hexToRGB
+    )