├── .ocamlformat ├── .gitignore ├── slacko.png ├── src ├── cli │ ├── dune │ └── slack_notify.ml └── lib │ ├── dune │ ├── timestamp.mli │ ├── timestamp.ml │ ├── slacko.mli │ └── slacko.ml ├── test ├── authed.json ├── slounit.ml ├── slackbot_history.json ├── ims.json ├── dune ├── groups.json ├── new_channel.json ├── random_history.json ├── seekrit_history.json ├── channels.json ├── users.json ├── conversations.json ├── fake_slack.ml ├── files.json ├── abbrtypes.ml └── test_slacko.ml ├── Makefile ├── dune-project ├── .github └── workflows │ └── ci.yaml ├── slacko.opam ├── CHANGES.md ├── README.md └── COPYING /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.26.1 2 | profile=conventional 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /_build/ 2 | /_opam/ 3 | /*.install 4 | .merlin 5 | -------------------------------------------------------------------------------- /slacko.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Leonidas-from-XIV/slacko/HEAD/slacko.png -------------------------------------------------------------------------------- /src/cli/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name slack_notify) 3 | (public_name slack-notify) 4 | (libraries slacko cmdliner)) 5 | -------------------------------------------------------------------------------- /test/authed.json: -------------------------------------------------------------------------------- 1 | { 2 | "user_id": "U3UMJU868", 3 | "user": "jerith", 4 | "url": "https://slackobot.slack.com/", 5 | "team_id": "T3UMV2E2H", 6 | "team": "slackobot" 7 | } 8 | -------------------------------------------------------------------------------- /src/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name slacko) 3 | (public_name slacko) 4 | (synopsis "A neat interface for Slack") 5 | (private_modules Timestamp) 6 | (libraries lwt cohttp-lwt-unix yojson ppx_deriving_yojson.runtime ptime) 7 | (preprocess 8 | (pps ppx_deriving_yojson))) 9 | -------------------------------------------------------------------------------- /test/slounit.ml: -------------------------------------------------------------------------------- 1 | let lwt_test test_fun ctx = Lwt_main.run @@ test_fun ctx 2 | 3 | let fake_slack_test test_fun ctx = 4 | lwt_test Fake_slack.with_fake_slack (fun () -> test_fun ctx) 5 | 6 | let fake_slack_tests label tests = 7 | let open OUnit2 in 8 | label >::: List.map (fun (l, f) -> l >:: fake_slack_test f) tests 9 | -------------------------------------------------------------------------------- /test/slackbot_history.json: -------------------------------------------------------------------------------- 1 | { 2 | "has_more": false, 3 | "messages": [ 4 | { 5 | "text": "If you have any questions about *how to use Slack*, please ask me! I’ll do my best to help.", 6 | "ts": "1484993303.000002", 7 | "type": "message", 8 | "user": "USLACKBOT" 9 | } 10 | ] 11 | } 12 | -------------------------------------------------------------------------------- /test/ims.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "created": 1484993283, 4 | "id": "D3UMJU8VA", 5 | "is_im": true, 6 | "is_org_shared": false, 7 | "is_user_deleted": false, 8 | "user": "USLACKBOT" 9 | }, 10 | { 11 | "created": 1484993283, 12 | "id": "D3TUQB1PB", 13 | "is_im": true, 14 | "is_org_shared": false, 15 | "is_user_deleted": false, 16 | "user": "U3UMJU868" 17 | } 18 | ] 19 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets timestamp.ml) 3 | (deps ../src/lib/timestamp.ml) 4 | (action 5 | (copy %{deps} %{targets}))) 6 | 7 | (executable 8 | (name test_slacko) 9 | (libraries slacko ounit2) 10 | (preprocess 11 | (pps ppx_deriving_yojson ppx_deriving.std))) 12 | 13 | (rule 14 | (alias runtest) 15 | (deps 16 | (:test 17 | (file test_slacko.exe)) 18 | (glob_files *.json)) 19 | (action 20 | (run %{test} -runner sequential))) 21 | -------------------------------------------------------------------------------- /test/groups.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "created": 1492937682, 4 | "creator": "U3UMJU868", 5 | "id": "G536YKXPE", 6 | "is_archived": false, 7 | "is_group": true, 8 | "is_mpim": false, 9 | "members": [ 10 | "U3UMJU868" 11 | ], 12 | "name": "seekrit", 13 | "name_normalized": "seekrit", 14 | "purpose": { 15 | "creator": "U3UMJU868", 16 | "last_set": 1492937683, 17 | "value": "Secret place for secretly secreting secrets" 18 | }, 19 | "topic": { 20 | "creator": "", 21 | "last_set": 0, 22 | "value": "" 23 | } 24 | } 25 | ] 26 | -------------------------------------------------------------------------------- /test/new_channel.json: -------------------------------------------------------------------------------- 1 | { 2 | "created": 1485611957, 3 | "creator": "U3UMJU868", 4 | "id": "C3X3D0K88", 5 | "is_archived": false, 6 | "is_channel": true, 7 | "is_general": false, 8 | "is_member": true, 9 | "last_read": "0000000000.000000", 10 | "latest": null, 11 | "members": [ 12 | "U3UMJU868" 13 | ], 14 | "name": "new_channel", 15 | "name_normalized": "new_channel", 16 | "previous_names": [], 17 | "purpose": { 18 | "creator": "", 19 | "last_set": 0, 20 | "value": "" 21 | }, 22 | "topic": { 23 | "creator": "", 24 | "last_set": 0, 25 | "value": "" 26 | }, 27 | "unread_count": 0, 28 | "unread_count_display": 0 29 | } 30 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: ## Build the code 3 | dune build 4 | 5 | .PHONY: clean 6 | clean: ## Clean source tree 7 | dune clean 8 | 9 | .PHONY: test 10 | test: ## Run the tests 11 | dune runtest --force 12 | 13 | .PHONY: distrib 14 | distrib: ## Create a distribution tarball 15 | dune-release distrib 16 | 17 | .PHONY: tag 18 | tag: ## Tag the current release 19 | dune-release tag 20 | 21 | .PHONY: publish 22 | publish: ## Put the release on GitHub 23 | dune-release publish distrib 24 | 25 | .PHONY: help 26 | help: ## Show this help 27 | @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' 28 | -------------------------------------------------------------------------------- /test/random_history.json: -------------------------------------------------------------------------------- 1 | { 2 | "has_more": false, 3 | "messages": [ 4 | { 5 | "subtype": "me_message", 6 | "text": "thinks you are.", 7 | "ts": "1492867855.021331", 8 | "type": "message", 9 | "user": "U3UMJU868" 10 | }, 11 | { 12 | "text": "I am not a slackobot. Are you?", 13 | "ts": "1492867843.020464", 14 | "type": "message", 15 | "user": "U3UMJU868" 16 | }, 17 | { 18 | "text": "hello", 19 | "ts": "1492867142.979902", 20 | "type": "message", 21 | "user": "U3UMJU868" 22 | }, 23 | { 24 | "subtype": "channel_join", 25 | "text": "<@U3UMJU868|jerith> has joined the channel", 26 | "ts": "1484993283.000002", 27 | "type": "message", 28 | "user": "U3UMJU868" 29 | } 30 | ] 31 | } 32 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name slacko) 3 | 4 | (generate_opam_files true) 5 | 6 | (authors "Marek Kubica ") 7 | (maintainers "Marek Kubica ") 8 | (license "OCaml-LGPL-3.0-linking-exception") 9 | (source (github Leonidas-from-XIV/slacko)) 10 | 11 | (package 12 | (name slacko) 13 | (synopsis "Type-safe binding to the Slack API") 14 | (description "Slacko provides an easy to use interface to the Slack REST API, which allows to 15 | join Slack channels, post messages, create channels and groups and manage 16 | those, upload and search files, manage presence.") 17 | (depends 18 | (ocaml (>= 4.08)) 19 | (cmdliner (>= 1.1.0)) 20 | (yojson (>= 1.6.0)) 21 | (lwt (>= 5.3.0)) 22 | tls-lwt 23 | (cohttp-lwt-unix (>= 1.0.0)) 24 | (ppx_deriving_yojson (>= 3.3)) 25 | ptime 26 | (ounit2 (and :with-test (>= 2.2))) 27 | (ppx_deriving (and :with-test (>= 5.2.1)))) 28 | (conflicts 29 | ;; broken release: https://github.com/mirage/ocaml-conduit/issues/189 30 | (conduit (= 0.14.1)))) 31 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: 15 | - ubuntu-20.04 16 | 17 | ocaml-compiler: 18 | - 4.08.x 19 | - 4.14.x 20 | 21 | runs-on: ${{ matrix.os }} 22 | 23 | steps: 24 | - name: Checkout code 25 | uses: actions/checkout@v4 26 | 27 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 28 | uses: ocaml/setup-ocaml@v2 29 | with: 30 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 31 | 32 | - name: Lint fmt 33 | uses: ocaml/setup-ocaml/lint-fmt@v2 34 | 35 | - name: Install dependencies 36 | run: | 37 | opam install . --deps-only --with-test 38 | 39 | - name: Build 40 | run: | 41 | opam exec -- dune build @all 42 | 43 | - name: Tests 44 | run: | 45 | opam exec -- dune build @runtest 46 | 47 | - name: Opam Lint 48 | run: | 49 | opam lint slacko.opam 50 | -------------------------------------------------------------------------------- /src/lib/timestamp.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Slacko - Binding to the Slack API 3 | * Copyright (C) 2014-2019 Marek Kubica 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 3.0 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file COPYING. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | type t = Ptime.t 22 | 23 | val to_string : t -> string 24 | val of_yojson : Yojson.Safe.t -> (t, string) result 25 | val to_yojson : t -> Yojson.Safe.t 26 | val pp : Format.formatter -> t -> unit 27 | -------------------------------------------------------------------------------- /test/seekrit_history.json: -------------------------------------------------------------------------------- 1 | { 2 | "has_more": false, 3 | "messages": [ 4 | { 5 | "text": "Want an X.509 private key?", 6 | "ts": "1492937859.690158", 7 | "type": "message", 8 | "user": "U3UMJU868" 9 | }, 10 | { 11 | "subtype": "me_message", 12 | "text": "lurks in a shadow.", 13 | "ts": "1492937718.682784", 14 | "type": "message", 15 | "user": "U3UMJU868" 16 | }, 17 | { 18 | "text": "Hey you, pssst.", 19 | "ts": "1492937707.682226", 20 | "type": "message", 21 | "user": "U3UMJU868" 22 | }, 23 | { 24 | "text": "Pssssst.", 25 | "ts": "1492937698.681778", 26 | "type": "message", 27 | "user": "U3UMJU868" 28 | }, 29 | { 30 | "purpose": "Secret place for secretly secreting secrets", 31 | "subtype": "group_purpose", 32 | "text": "<@U3UMJU868|jerith> set the channel's purpose: Secret place for secretly secreting secrets", 33 | "ts": "1492937683.680879", 34 | "type": "message", 35 | "user": "U3UMJU868" 36 | }, 37 | { 38 | "subtype": "group_join", 39 | "text": "<@U3UMJU868|jerith> has joined the group", 40 | "ts": "1492937682.680791", 41 | "type": "message", 42 | "user": "U3UMJU868" 43 | } 44 | ] 45 | } 46 | -------------------------------------------------------------------------------- /slacko.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Type-safe binding to the Slack API" 4 | description: """ 5 | Slacko provides an easy to use interface to the Slack REST API, which allows to 6 | join Slack channels, post messages, create channels and groups and manage 7 | those, upload and search files, manage presence.""" 8 | maintainer: ["Marek Kubica "] 9 | authors: ["Marek Kubica "] 10 | license: "OCaml-LGPL-3.0-linking-exception" 11 | homepage: "https://github.com/Leonidas-from-XIV/slacko" 12 | bug-reports: "https://github.com/Leonidas-from-XIV/slacko/issues" 13 | depends: [ 14 | "dune" {>= "2.0"} 15 | "ocaml" {>= "4.08"} 16 | "cmdliner" {>= "1.1.0"} 17 | "yojson" {>= "1.6.0"} 18 | "lwt" {>= "5.3.0"} 19 | "tls-lwt" 20 | "cohttp-lwt-unix" {>= "1.0.0"} 21 | "ppx_deriving_yojson" {>= "3.3"} 22 | "ptime" 23 | "ounit2" {with-test & >= "2.2"} 24 | "ppx_deriving" {with-test & >= "5.2.1"} 25 | ] 26 | conflicts: [ 27 | "conduit" {= "0.14.1"} 28 | ] 29 | build: [ 30 | ["dune" "subst"] {pinned} 31 | [ 32 | "dune" 33 | "build" 34 | "-p" 35 | name 36 | "-j" 37 | jobs 38 | "@install" 39 | "@runtest" {with-test} 40 | "@doc" {with-doc} 41 | ] 42 | ] 43 | dev-repo: "git+https://github.com/Leonidas-from-XIV/slacko.git" 44 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.15.0 2 | ------ 3 | 4 | * Better handling of timestamps (@paurkedal) 5 | * Update user type to match what Slack returns (@Khady) 6 | * Update OPAM metadata to 2.0 format 7 | * Fixed brittle build 8 | 9 | 0.14.1 10 | ------ 11 | 12 | * Support additional arguments to `chat.post_message` and `chat.update` 13 | * Adjust build process to use `dune` instead of `jbuilder` 14 | * Replace `topkg` code with `dune-release` 15 | 16 | 0.14.0 17 | ------ 18 | 19 | * Higher precision timestamps. 20 | * Adjust to changes in Slack APIs. 21 | * Support for CoHTTP > 1.0. 22 | * Ported to jbuilder, should yield easier integration with whole ecosystem, 23 | faster builds and less boilerplate. 24 | * Depend on OCaml 4.04. 25 | * Add support for releasing via `topkg`, thus adding this changelog. 26 | 27 | 0.13.0 28 | ------ 29 | 30 | * Fixes a number of previously broken endpoints. 31 | * Adds an integration test to make sure that whatever is implemented keeps on 32 | working. 33 | 34 | 0.12.0 35 | ------ 36 | 37 | * Added type `chat` to abstract away from all types of channels Slack supports. 38 | * Removed topic-is-too-long errors as the binding checks the topic length 39 | beforehand. 40 | * Added `conversation` as a new type instead of string IM conversation type. 41 | * More syntactic sugar in code, endpoint definitions now a long pipe. 42 | 43 | 0.11.0 44 | ------ 45 | 46 | * The binding now looks up User/Channel/Group IDs and rejects invalid ones. 47 | * The message length is now validated: messages that are too long cannot be 48 | generated anymore. 49 | * Adds support for some more new Slack methods: 50 | - `channels.archive` 51 | - `channels.create` 52 | - `channels.rename` 53 | - `channels.unarchive` 54 | - `groups.archive` 55 | - `groups.rename` 56 | - `groups.unarchive` 57 | 58 | 0.10.0 59 | ------ 60 | 61 | In this release, one of the main criticisms was addressed: the API calls are 62 | now represented by their own types, so there are now channel types, user types 63 | and many more. Some parameters can have only a limited number of values, these 64 | are also represented using their own types so calling the methods with 65 | incorrect values is impossible. 66 | 67 | The code was updated to use the new Lwt 2.4.6 ppx macros instead of Camlp4, so 68 | this is the minimum required release. Also, better use OCaml 4.02.0 for 69 | improved support for ppx. 70 | 71 | 0.9.1 72 | ----- 73 | 74 | * Added `users.info` method. 75 | * Broken up `apierror` into a set of more relevant types per function. 76 | 77 | 0.9.0 78 | ----- 79 | 80 | Time to get this code to the internetz! 81 | 82 | Features: 83 | 84 | * 100% API coverage and a handy tool to post messages to Slack. 85 | * Also, some rudimentary docs and a neat logo made by yours truly. 86 | -------------------------------------------------------------------------------- /src/lib/timestamp.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Slacko - Binding to the Slack API 3 | * Copyright (C) 2014-2019 Marek Kubica 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 3.0 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file COPYING. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | let int64_pow b n = 22 | let rec loop b n acc = 23 | if n = 0 then acc 24 | else 25 | loop 26 | Int64.(mul b b) 27 | (n lsr 1) 28 | (if n land 1 = 0 then acc else Int64.(mul b acc)) 29 | in 30 | loop b n 1L 31 | 32 | type t = Ptime.t 33 | 34 | let pp = Ptime.pp_human ~frac_s:6 () 35 | 36 | let of_string x = 37 | let d_ps_of_intlit intlit = 38 | let sec = Int64.of_string intlit in 39 | let d = Int64.div sec 86_400L in 40 | let ps = Int64.(mul (rem sec 86_400L) 1_000_000_000_000L) in 41 | (Int64.to_int d, ps) 42 | in 43 | match 44 | match String.split_on_char '.' x with 45 | | [ _ ] -> Ptime.Span.of_d_ps (d_ps_of_intlit x) 46 | | [ sec_lit; subsec_lit ] -> 47 | let d, ps_int = d_ps_of_intlit sec_lit in 48 | let ps_frac = 49 | if String.length subsec_lit <= 12 then 50 | let scale = int64_pow 10L (12 - String.length subsec_lit) in 51 | Int64.mul scale (Int64.of_string subsec_lit) 52 | else Int64.of_string (String.sub subsec_lit 0 12) 53 | in 54 | Ptime.Span.of_d_ps (d, Int64.add ps_int ps_frac) 55 | | _ -> None 56 | with 57 | | exception Failure _ -> None 58 | | None -> None 59 | | Some span -> Ptime.of_span span 60 | 61 | let to_string ts = 62 | let d, ps = Ptime.Span.to_d_ps (Ptime.diff ts Ptime.epoch) in 63 | let sec = Int64.(add (mul (of_int d) 86_400L) (div ps 1_000_000_000_000L)) in 64 | let subsec = Int64.(rem ps 1_000_000_000_000L) in 65 | Printf.sprintf "%Ld.%06Ld" sec (Int64.div subsec 1_000_000L) 66 | 67 | let of_yojson json = 68 | match 69 | match json with 70 | | `Int x -> Ptime.of_span (Ptime.Span.of_int_s x) 71 | | `Intlit x -> of_string x 72 | | `String x -> of_string x 73 | | _ -> None 74 | with 75 | | Some ts -> Ok ts 76 | | None -> Error "Couldn't parse timestamp" 77 | 78 | let to_yojson ts = `String (to_string ts) 79 | -------------------------------------------------------------------------------- /test/channels.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "id": "C3XTJPLFL", 4 | "name": "archivable_channel", 5 | "is_channel": true, 6 | "created": 1485679967, 7 | "creator": "U3UMJU868", 8 | "is_archived": false, 9 | "is_general": false, 10 | "is_member": true, 11 | "members": [ 12 | "U3UMJU868" 13 | ], 14 | "topic": { 15 | "value": "", 16 | "creator": "", 17 | "last_set": 0 18 | }, 19 | "purpose": { 20 | "value": "", 21 | "creator": "", 22 | "last_set": 0 23 | }, 24 | "previous_names": [], 25 | "num_members": 1 26 | }, 27 | { 28 | "id": "C3XTHDCTC", 29 | "name": "archived_channel", 30 | "is_channel": true, 31 | "created": 1485678562, 32 | "creator": "U3UMJU868", 33 | "is_archived": true, 34 | "is_general": false, 35 | "is_member": false, 36 | "members": [], 37 | "topic": { 38 | "value": "", 39 | "creator": "", 40 | "last_set": 0 41 | }, 42 | "purpose": { 43 | "value": "", 44 | "creator": "", 45 | "last_set": 0 46 | }, 47 | "previous_names": [], 48 | "num_members": 0 49 | }, 50 | { 51 | "id": "C3UK9TS3C", 52 | "name": "general", 53 | "is_channel": true, 54 | "created": 1484993283, 55 | "creator": "U3UMJU868", 56 | "is_archived": false, 57 | "is_general": true, 58 | "is_member": true, 59 | "members": [ 60 | "U3UMJU868" 61 | ], 62 | "topic": { 63 | "value": "Company-wide announcements and work-based matters", 64 | "creator": "", 65 | "last_set": 0 66 | }, 67 | "purpose": { 68 | "value": "This channel is for team-wide communication and announcements. All team members are in this channel.", 69 | "creator": "", 70 | "last_set": 0 71 | }, 72 | "previous_names": [], 73 | "num_members": 1 74 | }, 75 | { 76 | "id": "C3TTWNCTA", 77 | "name": "random", 78 | "is_channel": true, 79 | "created": 1484993283, 80 | "creator": "U3UMJU868", 81 | "is_archived": false, 82 | "is_general": false, 83 | "is_member": true, 84 | "members": [ 85 | "U3UMJU868" 86 | ], 87 | "topic": { 88 | "value": "Non-work banter and water cooler conversation", 89 | "creator": "", 90 | "last_set": 0 91 | }, 92 | "purpose": { 93 | "value": "A place for non-work-related flimflam, faffing, hodge-podge or jibber-jabber you'd prefer to keep out of more focused work-related channels.", 94 | "creator": "", 95 | "last_set": 0 96 | }, 97 | "previous_names": [], 98 | "num_members": 1 99 | }, 100 | { 101 | "id": "C3V9V3E9L", 102 | "name": "slackobot", 103 | "is_channel": true, 104 | "created": 1484993366, 105 | "creator": "U3UMJU868", 106 | "is_archived": false, 107 | "is_general": false, 108 | "is_member": true, 109 | "members": [ 110 | "U3UMJU868" 111 | ], 112 | "topic": { 113 | "value": "", 114 | "creator": "", 115 | "last_set": 0 116 | }, 117 | "purpose": { 118 | "value": "Testing slackobot.", 119 | "creator": "U3UMJU868", 120 | "last_set": 1484993366 121 | }, 122 | "previous_names": [], 123 | "num_members": 1 124 | } 125 | ] 126 | -------------------------------------------------------------------------------- /test/users.json: -------------------------------------------------------------------------------- 1 | { 2 | "cache_ts": 1492880206, 3 | "members": [ 4 | { 5 | "color": "9f69e7", 6 | "deleted": false, 7 | "has_2fa": false, 8 | "id": "U3UMJU868", 9 | "is_admin": true, 10 | "is_bot": false, 11 | "is_owner": true, 12 | "is_primary_owner": true, 13 | "is_restricted": false, 14 | "is_ultra_restricted": false, 15 | "name": "jerith", 16 | "profile": { 17 | "avatar_hash": "gb7842ee0df3", 18 | "email": "firxen@gmail.com", 19 | "first_name": "Jeremy", 20 | "image_192": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=192&d=https%3A%2F%2Fa.slack-edge.com%2F7fa9%2Fimg%2Favatars%2Fava_0011-192.png", 21 | "image_24": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=24&d=https%3A%2F%2Fa.slack-edge.com%2F66f9%2Fimg%2Favatars%2Fava_0011-24.png", 22 | "image_32": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=32&d=https%3A%2F%2Fa.slack-edge.com%2F66f9%2Fimg%2Favatars%2Fava_0011-32.png", 23 | "image_48": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=48&d=https%3A%2F%2Fa.slack-edge.com%2F66f9%2Fimg%2Favatars%2Fava_0011-48.png", 24 | "image_512": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=512&d=https%3A%2F%2Fa.slack-edge.com%2F7fa9%2Fimg%2Favatars%2Fava_0011-512.png", 25 | "image_72": "https://secure.gravatar.com/avatar/b7842ee0df3b024a6cad55bbe09c0d08.jpg?s=72&d=https%3A%2F%2Fa.slack-edge.com%2F3654%2Fimg%2Favatars%2Fava_0011-72.png", 26 | "last_name": "Thurgood", 27 | "real_name": "Jeremy Thurgood", 28 | "real_name_normalized": "Jeremy Thurgood" 29 | }, 30 | "real_name": "Jeremy Thurgood", 31 | "status": null, 32 | "team_id": "T3UMV2E2H", 33 | "tz": "Africa/Harare", 34 | "tz_label": "Central Africa Time", 35 | "tz_offset": 7200, 36 | "updated": 1484993283 37 | }, 38 | { 39 | "color": "757575", 40 | "deleted": false, 41 | "id": "USLACKBOT", 42 | "is_admin": false, 43 | "is_bot": false, 44 | "is_owner": false, 45 | "is_primary_owner": false, 46 | "is_restricted": false, 47 | "is_ultra_restricted": false, 48 | "name": "slackbot", 49 | "profile": { 50 | "always_active": true, 51 | "avatar_hash": "sv1444671949", 52 | "fields": null, 53 | "first_name": "slackbot", 54 | "image_192": "https://a.slack-edge.com/66f9/img/slackbot_192.png", 55 | "image_24": "https://a.slack-edge.com/0180/img/slackbot_24.png", 56 | "image_32": "https://a.slack-edge.com/2fac/plugins/slackbot/assets/service_32.png", 57 | "image_48": "https://a.slack-edge.com/2fac/plugins/slackbot/assets/service_48.png", 58 | "image_512": "https://a.slack-edge.com/1801/img/slackbot_512.png", 59 | "image_72": "https://a.slack-edge.com/0180/img/slackbot_72.png", 60 | "last_name": "", 61 | "real_name": "slackbot", 62 | "real_name_normalized": "slackbot" 63 | }, 64 | "real_name": "slackbot", 65 | "status": null, 66 | "team_id": "T3UMV2E2H", 67 | "tz": null, 68 | "tz_label": "Pacific Daylight Time", 69 | "tz_offset": -25200, 70 | "updated": 0 71 | } 72 | ] 73 | } 74 | -------------------------------------------------------------------------------- /test/conversations.json: -------------------------------------------------------------------------------- 1 | { 2 | "channels": [ 3 | { 4 | "id": "C3XTJPLFL", 5 | "name": "archivable_channel", 6 | "name_normalized": "archivable_channel", 7 | "is_channel": true, 8 | "created": 1485679967, 9 | "creator": "U3UMJU868", 10 | "is_archived": false, 11 | "is_general": false, 12 | "is_member": true, 13 | "topic": { 14 | "value": "", 15 | "creator": "", 16 | "last_set": 0 17 | }, 18 | "purpose": { 19 | "value": "", 20 | "creator": "", 21 | "last_set": 0 22 | }, 23 | "previous_names": [], 24 | "num_members": 1 25 | }, 26 | { 27 | "id": "C3XTHDCTC", 28 | "name": "archived_channel", 29 | "name_normalized": "archived_channel", 30 | "is_channel": true, 31 | "created": 1485678562, 32 | "creator": "U3UMJU868", 33 | "is_archived": true, 34 | "is_general": false, 35 | "is_member": false, 36 | "topic": { 37 | "value": "", 38 | "creator": "", 39 | "last_set": 0 40 | }, 41 | "purpose": { 42 | "value": "", 43 | "creator": "", 44 | "last_set": 0 45 | }, 46 | "previous_names": [], 47 | "num_members": 0 48 | }, 49 | { 50 | "id": "C3UK9TS3C", 51 | "name": "general", 52 | "name_normalized": "general", 53 | "is_channel": true, 54 | "created": 1484993283, 55 | "creator": "U3UMJU868", 56 | "is_archived": false, 57 | "is_general": true, 58 | "is_member": true, 59 | "topic": { 60 | "value": "Company-wide announcements and work-based matters", 61 | "creator": "", 62 | "last_set": 0 63 | }, 64 | "purpose": { 65 | "value": "This channel is for team-wide communication and announcements. All team members are in this channel.", 66 | "creator": "", 67 | "last_set": 0 68 | }, 69 | "previous_names": [], 70 | "num_members": 1 71 | }, 72 | { 73 | "id": "C3TTWNCTA", 74 | "name": "random", 75 | "name_normalized": "random", 76 | "is_channel": true, 77 | "created": 1484993283, 78 | "creator": "U3UMJU868", 79 | "is_archived": false, 80 | "is_general": false, 81 | "is_member": true, 82 | "topic": { 83 | "value": "Non-work banter and water cooler conversation", 84 | "creator": "", 85 | "last_set": 0 86 | }, 87 | "purpose": { 88 | "value": "A place for non-work-related flimflam, faffing, hodge-podge or jibber-jabber you'd prefer to keep out of more focused work-related channels.", 89 | "creator": "", 90 | "last_set": 0 91 | }, 92 | "previous_names": [], 93 | "num_members": 1 94 | }, 95 | { 96 | "id": "C3V9V3E9L", 97 | "name": "slackobot", 98 | "name_normalized": "slackobot", 99 | "is_channel": true, 100 | "created": 1484993366, 101 | "creator": "U3UMJU868", 102 | "is_archived": false, 103 | "is_general": false, 104 | "is_member": true, 105 | "topic": { 106 | "value": "", 107 | "creator": "", 108 | "last_set": 0 109 | }, 110 | "purpose": { 111 | "value": "Testing slackobot.", 112 | "creator": "U3UMJU868", 113 | "last_set": 1484993366 114 | }, 115 | "previous_names": [], 116 | "num_members": 1 117 | } 118 | ] 119 | } 120 | -------------------------------------------------------------------------------- /src/cli/slack_notify.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * slack-notify - Posts messages to Slack channels 3 | * Copyright (C) 2014-2015 Marek Kubica 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 3.0 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file COPYING. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | let base_url = 22 | let doc = "The Slack API base URL" in 23 | Cmdliner.Arg.( 24 | value & opt (some string) None & info [ "base-url" ] ~docv:"URL" ~doc) 25 | 26 | let token = 27 | let doc = "The Slack API access token" in 28 | Cmdliner.Arg.( 29 | required & opt (some string) None & info [ "t"; "token" ] ~docv:"TOKEN" ~doc) 30 | 31 | let username = 32 | let doc = "Name of the bot in the chat" in 33 | Cmdliner.Arg.( 34 | value 35 | & opt (some string) None 36 | & info [ "u"; "username" ] ~docv:"USERNAME" ~doc) 37 | 38 | let icon_url = 39 | let doc = "URL to an image to use as the icon for this message" in 40 | Cmdliner.Arg.( 41 | value & opt (some string) None & info [ "icon-url" ] ~docv:"URL" ~doc) 42 | 43 | let icon_emoji = 44 | let doc = "Emoji to use as the icon for this message. Overrides icon-url" in 45 | Cmdliner.Arg.( 46 | value & opt (some string) None & info [ "icon-emoji" ] ~docv:"EMOJI" ~doc) 47 | 48 | let channel = 49 | let doc = "Name of the channel to post to" in 50 | Cmdliner.Arg.( 51 | required & pos 0 (some string) None & info [] ~docv:"CHANNEL" ~doc) 52 | 53 | let message = 54 | let doc = "Message to send" in 55 | Cmdliner.Arg.(required & pos 1 (some string) None & info [] ~docv:"MSG" ~doc) 56 | 57 | let attachment = 58 | let doc = "Attachment text" in 59 | Cmdliner.Arg.( 60 | value & opt (some string) None & info [ "attachment" ] ~docv:"MSG" ~doc) 61 | 62 | let info = 63 | let doc = "Posts messages to Slack" in 64 | Cmdliner.Cmd.info "slack-notify" ~doc 65 | 66 | let execute base_url token username channel icon_url icon_emoji attachment_text 67 | msg = 68 | "Your token is " ^ token ^ ", the channel is " ^ channel 69 | ^ " and the message is '" ^ msg ^ "'." 70 | |> print_endline; 71 | 72 | let string_or_bust = function 73 | | `Success _ -> "Message posted" 74 | | `Invalid_auth -> "Invalid token" 75 | | `Channel_not_found -> "Channel unknown" 76 | | `Is_archived -> "Channel is archived" 77 | | `Msg_too_long -> "Message too long" 78 | | `Rate_limited -> "Rate limit active" 79 | | _ -> "Unknown error" 80 | in 81 | 82 | let open Lwt in 83 | let session = Slacko.start_session ?base_url token in 84 | let channel = Slacko.channel_of_string channel in 85 | let chat = Slacko.Channel channel in 86 | let msg = Slacko.message_of_string msg in 87 | let attachments = 88 | match attachment_text with 89 | | None -> None 90 | | Some text -> Some [ Slacko.attachment ~text () ] 91 | in 92 | Slacko.chat_post_message session chat ?username ?icon_emoji ?icon_url 93 | ?attachments msg 94 | >|= (fun c -> print_endline @@ string_or_bust c) 95 | |> Lwt_main.run 96 | 97 | let execute_t = 98 | Cmdliner.Term.( 99 | const execute $ base_url $ token $ username $ channel $ icon_url 100 | $ icon_emoji $ attachment $ message) 101 | 102 | let () = 103 | let cmd = Cmdliner.Cmd.v info execute_t in 104 | exit Cmdliner.(Cmd.eval cmd) 105 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Slacko 2 | ====== 3 | 4 | ![Slacko logo](slacko.png) A neat interface for [Slack](https://slack.com/) 5 | 6 | [![Build Status](https://img.shields.io/endpoint?url=https%3A%2F%2Fci.ocamllabs.io%2Fbadge%2FLeonidas-from-XIV%2Fslacko%2Fmaster&logo=ocaml)](https://ci.ocamllabs.io/github/Leonidas-from-XIV/slacko) [![Build Status](https://img.shields.io/github/actions/workflow/status/Leonidas-from-XIV/slacko/ci.yaml?label=GitHub%20CI)](https://github.com/Leonidas-from-XIV/slacko/actions/workflows/ci.yaml) 7 | 8 | Your company got you Slack and you're all like "yeah, and now I am forced to 9 | use a browser or what?". Fear no more, because as it turns out Slack has a REST 10 | API that can be accessed. 11 | 12 | Yeah, scripting Slack via `curl` sucks, so let's do something that sucks less. 13 | Maybe a bit? How about using an existing 14 | [integration](https://api.slack.com/community)? They are incomplete or for 15 | sucky languages? Glad you asked, because I have *just the right thing* for you: 16 | a neat interface to Slack via [OCaml](https://ocaml.org/)! 17 | 18 | What do you need? OCaml, OPAM and a Slack token. All for free, no asterisks, no 19 | hidden clauses. Life can be so easy. 20 | 21 | Install that cow! 22 | ----------------- 23 | 24 | Huzzah, I got you interested? Lucky you, Slacko can easily be installed via 25 | [OCaml Package Manager (OPAM)](https://opam.ocaml.org/), so you just write 26 | 27 | ```sh 28 | $ opam install slacko 29 | ``` 30 | 31 | Now wasn't this easy? Bet your ass it was! And you know what? It even gets 32 | better: it also installed you a nifty little executable called `slack-notify` 33 | which you can use to post directly to Slack *from your shell*, no programming 34 | required at all. Actually, once compiled, not even OCaml is required anymore, 35 | everything is self-contained. 36 | 37 | In case you want to manually install it, you can, too. There's a number of 38 | dependencies that you have to take care of yourself, for the list you'll have 39 | to check the [slacko.opam](slacko.opam) file. 40 | 41 | Then you can build Slacko by yourself: 42 | 43 | ```sh 44 | $ make 45 | ``` 46 | 47 | How do I even use this thing? 48 | ----------------------------- 49 | 50 | The workflow is always very simple: you get a token from Slack either manually 51 | or my querying the OAuth API. Then you can instantly use any API method that 52 | Slacko supports. If you want, you can look at snapshot of 53 | [the Slacko docs](http://leonidas-from-xiv.github.io/slacko/) to see what 54 | functions are available (hint: all of them). 55 | 56 | 57 | Ready, set, go! 58 | --------------- 59 | 60 | Not convinced yet? Check out this neat documentation from `slack-notify` to 61 | help you out. 62 | 63 | ``` 64 | NAME 65 | slack-notify - Writes messages to slack 66 | 67 | SYNOPSIS 68 | slack-notify [OPTION]... CHANNEL MSG 69 | 70 | ARGUMENTS 71 | CHANNEL 72 | Name of the channel to post to 73 | 74 | MSG Message to send 75 | 76 | OPTIONS 77 | --help[=FMT] (default=pager) 78 | Show this help in format FMT (pager, plain or groff). 79 | 80 | --icon-emoji=EMOJI 81 | emoji to use as the icon for this message. Overrides icon-url 82 | 83 | --icon-url=URL 84 | URL to an image to use as the icon for this message 85 | 86 | -t TOKEN, --token=TOKEN 87 | The Slack API access token 88 | 89 | -u USERNAME, --username=USERNAME 90 | Name of the bot in the chat 91 | ``` 92 | 93 | So what is this token thing? Once you signed up for Slack, you can get a token 94 | for every team you are in from [the Slack API docs](https://api.slack.com/). 95 | Click on the "get token" link and you're all set. 96 | 97 | But I do want to code my own stuff! 98 | ----------------------------------- 99 | 100 | You know, Slacko is a nice gal/guy. So you can just plug together whatever you 101 | want with it, since it currently implements [100% of the Slack 102 | API](https://api.slack.com/methods)! Well, except for the Real-Time-Messaging 103 | part, which is on our TODO! How neat is this? And you can use it in your own 104 | code without worrying about the license one bit, since the 105 | [LGPL 3.0](https://www.gnu.org/licenses/lgpl.html) is liberal for re-use, 106 | coupled with the 107 | [OCaml linking exception](http://caml.inria.fr/pub/old_caml_site/ocaml/LICENSE.html). 108 | For realz! 109 | 110 | Something's amiss? 111 | ------------------ 112 | 113 | I know, I know, it is hardly believable that something could possibly be 114 | missing from this library. But wonders happen, and if you run into one of these 115 | cases, just shoot me a pull request. 116 | 117 | Credit where credit's due 118 | ------------------------- 119 | 120 | Thanks go to all the people who wrote 121 | [CoHTTP](https://github.com/mirage/ocaml-cohttp), a real-world HTTP library 122 | that doesn't suck and [Lwt](http://ocsigen.org/lwt/), an oddball library that 123 | subconsciously *makes sense*. Also, the fine folks in 124 | [#ocaml](http://irclog.whitequark.org/ocaml/) on 125 | [freenode](https://freenode.net/). 126 | -------------------------------------------------------------------------------- /test/fake_slack.ml: -------------------------------------------------------------------------------- 1 | (* A (currently pretty useless) fake slack implementation to run tests 2 | against. *) 3 | open Lwt 4 | open Cohttp_lwt_unix 5 | 6 | (* The only "valid" token we accept. *) 7 | let valid_token = "xoxp-testtoken" 8 | 9 | (* The following values come from data captured by a relay proxy between slacko 10 | and slack.com. They need to be replaced with something more generic that 11 | doesn't depend on the arbitrary details of a particular slack team. *) 12 | let ch_general = "C3UK9TS3C" 13 | let ch_random = "C3TTWNCTA" 14 | let ch_archivable = "C3XTJPLFL" 15 | let ch_archived = "C3XTHDCTC" 16 | let gr_seekrit = "G536YKXPE" 17 | 18 | (* slacko doesn't have a lookup function for us, so we just use it directly. *) 19 | let im_slackbot = "D3UMJU8VA" 20 | let channels_json = Yojson.Safe.from_file "channels.json" 21 | let conversations_json = Yojson.Safe.from_file "conversations.json" 22 | let new_channel_json = Yojson.Safe.from_file "new_channel.json" 23 | let authed_json = Yojson.Safe.from_file "authed.json" 24 | let random_history_json = Yojson.Safe.from_file "random_history.json" 25 | let users_json = Yojson.Safe.from_file "users.json" 26 | let files_json = Yojson.Safe.from_file "files.json" 27 | let groups_json = Yojson.Safe.from_file "groups.json" 28 | let seekrit_history_json = Yojson.Safe.from_file "seekrit_history.json" 29 | let ims_json = Yojson.Safe.from_file "ims.json" 30 | let slackbot_history_json = Yojson.Safe.from_file "slackbot_history.json" 31 | 32 | let json_fields = function 33 | | `Assoc fields -> fields 34 | | _ -> failwith "Can't parse test json." 35 | 36 | let reply_json ok fields = 37 | let body = `Assoc (("ok", `Bool ok) :: fields) |> Yojson.Safe.to_string in 38 | Server.respond_string ~status:`OK ~body () 39 | 40 | let reply_ok fields = reply_json true fields 41 | let reply_err err fields = reply_json false (("error", `String err) :: fields) 42 | 43 | let get_token_opt req = 44 | let headers = Cohttp.Request.headers req in 45 | let header = Cohttp.Header.get headers "Authorization" in 46 | match header with 47 | | Some x -> 48 | let hlen = String.length "Bearer " in 49 | Some (String.sub x hlen @@ (String.length x - hlen)) 50 | | _ -> None 51 | 52 | let get_arg_opt arg req = Uri.get_query_param (Request.uri req) arg 53 | 54 | let get_arg_default arg default req = 55 | match get_arg_opt arg req with Some x -> x | None -> default 56 | 57 | let get_arg arg req = 58 | match get_arg_opt arg req with 59 | | Some x -> x 60 | | None -> failwith @@ "Mandatory arg " ^ arg ^ " not given." 61 | 62 | let check_auth f req body = 63 | match get_token_opt req with 64 | | Some t when t = valid_token -> f req body 65 | | _ -> reply_err "invalid_auth" [] 66 | 67 | (* Request handlers *) 68 | 69 | let bad_path req _body = 70 | let path = req |> Request.uri |> Uri.path in 71 | reply_err "unknown_method" [ ("req_method", `String path) ] 72 | 73 | let api_test req _body = 74 | let args = req |> Request.uri |> Uri.query in 75 | let field_of_arg (k, v) = (k, `String (List.hd v)) in 76 | let fields = 77 | match args with 78 | | [] -> [] 79 | | args -> [ ("args", `Assoc (List.map field_of_arg args)) ] 80 | in 81 | match Uri.get_query_param (Request.uri req) "error" with 82 | | None -> reply_ok fields 83 | | Some err -> reply_err err fields 84 | 85 | let auth_test _req _body = reply_ok (json_fields authed_json) 86 | 87 | let channels_archive req _body = 88 | match get_arg "channel" req with 89 | | ch when ch = ch_general -> reply_err "cant_archive_general" [] 90 | | ch when ch = ch_archivable -> reply_ok [] 91 | | ch when ch = ch_archived -> reply_err "already_archived" [] 92 | | _ -> reply_err "channel_not_found" [] 93 | 94 | let channels_create req _body = 95 | match get_arg "name" req with 96 | | "general" | "random" -> reply_err "name_taken" [] 97 | | "new_channel" | _ -> reply_ok [ ("channel", new_channel_json) ] 98 | 99 | let channels_history req _body = 100 | (* TODO: Check various filtering params. *) 101 | match get_arg "channel" req with 102 | | ch when ch = ch_random -> reply_ok (json_fields random_history_json) 103 | | _ -> reply_err "channel_not_found" [] 104 | 105 | let channels_list _req _body = 106 | (* TODO: Check exclude_archived param. *) 107 | reply_ok [ ("channels", channels_json) ] 108 | 109 | let files_list _req _body = 110 | (* TODO: Check various filtering params. *) 111 | reply_ok (json_fields files_json) 112 | 113 | let groups_list _req _body = 114 | (* TODO: Check exclude_archived param. *) 115 | reply_ok [ ("groups", groups_json) ] 116 | 117 | let groups_history req _body = 118 | (* TODO: Check various filtering params. *) 119 | match get_arg "channel" req with 120 | | gr when gr = gr_seekrit -> reply_ok (json_fields seekrit_history_json) 121 | | _ -> reply_err "channel_not_found" [] 122 | 123 | let im_list _req _body = reply_ok [ ("ims", ims_json) ] 124 | 125 | let im_history req _body = 126 | (* TODO: Check various filtering params. *) 127 | match get_arg "channel" req with 128 | | im when im = im_slackbot -> reply_ok (json_fields slackbot_history_json) 129 | | _ -> reply_err "channel_not_found" [] 130 | 131 | let users_list _req _body = 132 | (* TODO: Check presence param. *) 133 | reply_ok (json_fields users_json) 134 | 135 | let conversations_list _req _body = reply_ok (json_fields conversations_json) 136 | 137 | (* Dispatcher, etc. *) 138 | 139 | let server ?(port = 7357) ~stop () = 140 | let callback _conn req body = 141 | let handler = 142 | match req |> Request.uri |> Uri.path with 143 | | "/api/api.test" -> api_test 144 | | "/api/auth.test" -> check_auth auth_test 145 | | "/api/channels.archive" -> check_auth channels_archive 146 | | "/api/channels.create" -> check_auth channels_create 147 | | "/api/channels.history" -> check_auth channels_history 148 | | "/api/channels.list" -> check_auth channels_list 149 | | "/api/files.list" -> check_auth files_list 150 | | "/api/groups.history" -> check_auth groups_history 151 | | "/api/groups.list" -> check_auth groups_list 152 | | "/api/im.history" -> check_auth im_history 153 | | "/api/im.list" -> check_auth im_list 154 | | "/api/users.list" -> check_auth users_list 155 | | "/api/conversations.list" -> check_auth conversations_list 156 | | _ -> bad_path 157 | in 158 | handler req body 159 | in 160 | Server.create ~mode:(`TCP (`Port port)) ~stop (Server.make ~callback ()) 161 | 162 | let with_fake_slack f = 163 | let stop, wake = wait () in 164 | let srv = server ~stop () in 165 | let stop_server _result = 166 | wakeup wake (); 167 | srv 168 | in 169 | finalize f stop_server 170 | -------------------------------------------------------------------------------- /test/files.json: -------------------------------------------------------------------------------- 1 | { 2 | "files": [ 3 | { 4 | "channels": [], 5 | "comments_count": 0, 6 | "created": 1484993283, 7 | "display_as_bot": false, 8 | "editable": true, 9 | "external_type": "", 10 | "filetype": "space", 11 | "groups": [], 12 | "id": "F3UMJU94L", 13 | "ims": [], 14 | "is_external": false, 15 | "is_public": true, 16 | "mimetype": "text/plain", 17 | "mode": "space", 18 | "name": "Welcome_to_Slack", 19 | "permalink": "https://slackobot.slack.com/files/slackbot/F3UMJU94L/welcome_to_slack", 20 | "permalink_public": "https://slack-files.com/T3UMV2E2H-F3UMJU94L-37beaf2b00", 21 | "pretty_type": "Post", 22 | "preview": "

Slack is here to help make your working life simpler, more pleasant, and more productive.

  • Communicate transparently and instantly with your team members in channels, or privately in direct messages (DMs).
  • Share and comment on files to get or give feedback on your projects.
  • Receive notifications when a team member mentions your name in a channel, file comment, or DM.
  • We keep track of which messages you've read and sync that information from the desktop to mobile and back again.
", 23 | "public_url_shared": false, 24 | "size": 1887, 25 | "state": "locked", 26 | "timestamp": 1484993283, 27 | "title": "Welcome to Slack!", 28 | "updated": 1484993283, 29 | "url_private": "https://files.slack.com/files-pri/T3UMV2E2H-F3UMJU94L/welcome_to_slack", 30 | "url_private_download": "https://files.slack.com/files-pri/T3UMV2E2H-F3UMJU94L/download/welcome_to_slack", 31 | "user": "USLACKBOT", 32 | "username": "" 33 | }, 34 | { 35 | "channels": [], 36 | "comments_count": 0, 37 | "created": 1484993283, 38 | "display_as_bot": false, 39 | "editable": true, 40 | "external_type": "", 41 | "filetype": "space", 42 | "groups": [], 43 | "id": "F3TTWND40", 44 | "ims": [], 45 | "is_external": false, 46 | "is_public": true, 47 | "mimetype": "text/plain", 48 | "mode": "space", 49 | "name": "Channels_Keep_Your_Conversations_Organized", 50 | "permalink": "https://slackobot.slack.com/files/slackbot/F3TTWND40/channels_keep_your_conversations_organized", 51 | "permalink_public": "https://slack-files.com/T3UMV2E2H-F3TTWND40-e6670a0e44", 52 | "pretty_type": "Post", 53 | "preview": "

Slack lets you join and create channels to keep your conversations organized and focused. Create channels for your functional teams, large projects, and topics of interest.

Find existing channels to join by clicking the more channels link below, or \"your channels\" above, your open channels. Or create a new one from those same menus (hint: you can also do the same thing by typing \"/open #name\" into the chat input).

When you join a channel, the entire message history is available to you. You can see who else is in that channel by clicking the members tab in the upper right corner of the message pane.

Remove a channel from your open channel list by typing /close in the chat input or from the channel's drop-down list. If you re-open the channel later, all the content will still be there, including messages exchanged when you didn't have the channel open.

You can view content from all your team's channels without joining the channel in the Message Archives. And when you search in Slack, the results show content from all channels, even if you are not in that one.

", 54 | "public_url_shared": false, 55 | "size": 1445, 56 | "state": "locked", 57 | "timestamp": 1484993283, 58 | "title": "Channels Keep Your Conversations Organized", 59 | "updated": 1484993283, 60 | "url_private": "https://files.slack.com/files-pri/T3UMV2E2H-F3TTWND40/channels_keep_your_conversations_organized", 61 | "url_private_download": "https://files.slack.com/files-pri/T3UMV2E2H-F3TTWND40/download/channels_keep_your_conversations_organized", 62 | "user": "USLACKBOT", 63 | "username": "" 64 | }, 65 | { 66 | "channels": [], 67 | "comments_count": 0, 68 | "created": 1484993283, 69 | "display_as_bot": false, 70 | "editable": true, 71 | "external_type": "", 72 | "filetype": "space", 73 | "groups": [], 74 | "id": "F3V9V05SS", 75 | "ims": [], 76 | "is_external": false, 77 | "is_public": true, 78 | "mimetype": "text/plain", 79 | "mode": "space", 80 | "name": "Getting_Started_with_Posts", 81 | "permalink": "https://slackobot.slack.com/files/slackbot/F3V9V05SS/getting_started_with_posts", 82 | "permalink_public": "https://slack-files.com/T3UMV2E2H-F3V9V05SS-342113c685", 83 | "pretty_type": "Post", 84 | "preview": "

Hi! Welcome to Posts, Slack's built-in document editor. Posts are a great way to share long-form content — like project plans, or documentation — directly in Slack. So how does one use Posts? Well, let's get right to it:

Creating a new Post

You can create a new Post from the + button in the Slack message input.

Formatting text

Text formatting in Posts was designed for simplicity, with just the right formatting options to help you get your thoughts organized.

", 85 | "public_url_shared": false, 86 | "size": 3294, 87 | "state": "locked", 88 | "timestamp": 1484993283, 89 | "title": "Getting Started with Posts", 90 | "updated": 1484993283, 91 | "url_private": "https://files.slack.com/files-pri/T3UMV2E2H-F3V9V05SS/getting_started_with_posts", 92 | "url_private_download": "https://files.slack.com/files-pri/T3UMV2E2H-F3V9V05SS/download/getting_started_with_posts", 93 | "user": "USLACKBOT", 94 | "username": "" 95 | }, 96 | { 97 | "channels": [], 98 | "comments_count": 0, 99 | "created": 1484993283, 100 | "display_as_bot": false, 101 | "editable": true, 102 | "external_type": "", 103 | "filetype": "space", 104 | "groups": [], 105 | "id": "F3UMJU96G", 106 | "ims": [], 107 | "is_external": false, 108 | "is_public": true, 109 | "mimetype": "text/plain", 110 | "mode": "space", 111 | "name": "Uploading_Your_Files_Into_Slack", 112 | "permalink": "https://slackobot.slack.com/files/slackbot/F3UMJU96G/uploading_your_files_into_slack", 113 | "permalink_public": "https://slack-files.com/T3UMV2E2H-F3UMJU96G-3d27c638d7", 114 | "pretty_type": "Post", 115 | "preview": "

Slack lets you add your files into a channel to get feedback from your team. Anyone who can see the document can add comments, and all those comments stay with the file. You can add your files into additional channels with the share command, and all comments and changes will flow back to those channels.

Just drag and drop the file into the Slack web app or click + File to the left of the chat input. You will be prompted to add a title, select a channel or individual, and will also have an option to make the file private for your eyes only. You can also add files from the mobile app using the + button in the Files tab.

Sharing a file with an individual in a direct message won't make that file public if it wasn't already; you can share private files on an individual basis and otherwise keep them private.

All the text in your file is indexed and searchable. Even PDFs.

", 116 | "public_url_shared": false, 117 | "size": 1141, 118 | "state": "locked", 119 | "timestamp": 1484993283, 120 | "title": "Uploading Your Files Into Slack", 121 | "updated": 1484993283, 122 | "url_private": "https://files.slack.com/files-pri/T3UMV2E2H-F3UMJU96G/uploading_your_files_into_slack", 123 | "url_private_download": "https://files.slack.com/files-pri/T3UMV2E2H-F3UMJU96G/download/uploading_your_files_into_slack", 124 | "user": "USLACKBOT", 125 | "username": "" 126 | } 127 | ], 128 | "paging": { 129 | "count": 100, 130 | "page": 1, 131 | "pages": 1, 132 | "total": 4 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | This library is free software; you can redistribute it and/or modify 2 | it under the terms of the GNU Lesser General Public License (LGPL) as 3 | published by the Free Software Foundation; either version 3.0 of the 4 | License (see below), or (at your option) any later version. 5 | 6 | As a special exception to the GNU Lesser General Public License, you 7 | may link, statically or dynamically, a "work that uses the Library" 8 | with a publicly distributed version of the Library to produce an 9 | executable file containing portions of the Library, and distribute 10 | that executable file under terms of your choice, without any of the 11 | additional requirements listed in clause 4 of the GNU Lesser General 12 | Public License. By "a publicly distributed version of the Library", 13 | we mean either the unmodified Library as distributed by the copyright 14 | holder, or a modified version of the Library that is distributed under 15 | the conditions defined in clause 2 of the GNU Lesser General Public 16 | License. This exception does not however invalidate any other reasons 17 | why the executable file might be covered by the GNU Lesser General 18 | Public License. 19 | 20 | 21 | GNU LESSER GENERAL PUBLIC LICENSE 22 | Version 3, 29 June 2007 23 | 24 | Copyright (C) 2007 Free Software Foundation, Inc. 25 | Everyone is permitted to copy and distribute verbatim copies 26 | of this license document, but changing it is not allowed. 27 | 28 | 29 | This version of the GNU Lesser General Public License incorporates 30 | the terms and conditions of version 3 of the GNU General Public 31 | License, supplemented by the additional permissions listed below. 32 | 33 | 0. Additional Definitions. 34 | 35 | As used herein, "this License" refers to version 3 of the GNU Lesser 36 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 37 | General Public License. 38 | 39 | "The Library" refers to a covered work governed by this License, 40 | other than an Application or a Combined Work as defined below. 41 | 42 | An "Application" is any work that makes use of an interface provided 43 | by the Library, but which is not otherwise based on the Library. 44 | Defining a subclass of a class defined by the Library is deemed a mode 45 | of using an interface provided by the Library. 46 | 47 | A "Combined Work" is a work produced by combining or linking an 48 | Application with the Library. The particular version of the Library 49 | with which the Combined Work was made is also called the "Linked 50 | Version". 51 | 52 | The "Minimal Corresponding Source" for a Combined Work means the 53 | Corresponding Source for the Combined Work, excluding any source code 54 | for portions of the Combined Work that, considered in isolation, are 55 | based on the Application, and not on the Linked Version. 56 | 57 | The "Corresponding Application Code" for a Combined Work means the 58 | object code and/or source code for the Application, including any data 59 | and utility programs needed for reproducing the Combined Work from the 60 | Application, but excluding the System Libraries of the Combined Work. 61 | 62 | 1. Exception to Section 3 of the GNU GPL. 63 | 64 | You may convey a covered work under sections 3 and 4 of this License 65 | without being bound by section 3 of the GNU GPL. 66 | 67 | 2. Conveying Modified Versions. 68 | 69 | If you modify a copy of the Library, and, in your modifications, a 70 | facility refers to a function or data to be supplied by an Application 71 | that uses the facility (other than as an argument passed when the 72 | facility is invoked), then you may convey a copy of the modified 73 | version: 74 | 75 | a) under this License, provided that you make a good faith effort to 76 | ensure that, in the event an Application does not supply the 77 | function or data, the facility still operates, and performs 78 | whatever part of its purpose remains meaningful, or 79 | 80 | b) under the GNU GPL, with none of the additional permissions of 81 | this License applicable to that copy. 82 | 83 | 3. Object Code Incorporating Material from Library Header Files. 84 | 85 | The object code form of an Application may incorporate material from 86 | a header file that is part of the Library. You may convey such object 87 | code under terms of your choice, provided that, if the incorporated 88 | material is not limited to numerical parameters, data structure 89 | layouts and accessors, or small macros, inline functions and templates 90 | (ten or fewer lines in length), you do both of the following: 91 | 92 | a) Give prominent notice with each copy of the object code that the 93 | Library is used in it and that the Library and its use are 94 | covered by this License. 95 | 96 | b) Accompany the object code with a copy of the GNU GPL and this license 97 | document. 98 | 99 | 4. Combined Works. 100 | 101 | You may convey a Combined Work under terms of your choice that, 102 | taken together, effectively do not restrict modification of the 103 | portions of the Library contained in the Combined Work and reverse 104 | engineering for debugging such modifications, if you also do each of 105 | the following: 106 | 107 | a) Give prominent notice with each copy of the Combined Work that 108 | the Library is used in it and that the Library and its use are 109 | covered by this License. 110 | 111 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 112 | document. 113 | 114 | c) For a Combined Work that displays copyright notices during 115 | execution, include the copyright notice for the Library among 116 | these notices, as well as a reference directing the user to the 117 | copies of the GNU GPL and this license document. 118 | 119 | d) Do one of the following: 120 | 121 | 0) Convey the Minimal Corresponding Source under the terms of this 122 | License, and the Corresponding Application Code in a form 123 | suitable for, and under terms that permit, the user to 124 | recombine or relink the Application with a modified version of 125 | the Linked Version to produce a modified Combined Work, in the 126 | manner specified by section 6 of the GNU GPL for conveying 127 | Corresponding Source. 128 | 129 | 1) Use a suitable shared library mechanism for linking with the 130 | Library. A suitable mechanism is one that (a) uses at run time 131 | a copy of the Library already present on the user's computer 132 | system, and (b) will operate properly with a modified version 133 | of the Library that is interface-compatible with the Linked 134 | Version. 135 | 136 | e) Provide Installation Information, but only if you would otherwise 137 | be required to provide such information under section 6 of the 138 | GNU GPL, and only to the extent that such information is 139 | necessary to install and execute a modified version of the 140 | Combined Work produced by recombining or relinking the 141 | Application with a modified version of the Linked Version. (If 142 | you use option 4d0, the Installation Information must accompany 143 | the Minimal Corresponding Source and Corresponding Application 144 | Code. If you use option 4d1, you must provide the Installation 145 | Information in the manner specified by section 6 of the GNU GPL 146 | for conveying Corresponding Source.) 147 | 148 | 5. Combined Libraries. 149 | 150 | You may place library facilities that are a work based on the 151 | Library side by side in a single library together with other library 152 | facilities that are not Applications and are not covered by this 153 | License, and convey such a combined library under terms of your 154 | choice, if you do both of the following: 155 | 156 | a) Accompany the combined library with a copy of the same work based 157 | on the Library, uncombined with any other library facilities, 158 | conveyed under the terms of this License. 159 | 160 | b) Give prominent notice with the combined library that part of it 161 | is a work based on the Library, and explaining where to find the 162 | accompanying uncombined form of the same work. 163 | 164 | 6. Revised Versions of the GNU Lesser General Public License. 165 | 166 | The Free Software Foundation may publish revised and/or new versions 167 | of the GNU Lesser General Public License from time to time. Such new 168 | versions will be similar in spirit to the present version, but may 169 | differ in detail to address new problems or concerns. 170 | 171 | Each version is given a distinguishing version number. If the 172 | Library as you received it specifies that a certain numbered version 173 | of the GNU Lesser General Public License "or any later version" 174 | applies to it, you have the option of following the terms and 175 | conditions either of that published version or of any later version 176 | published by the Free Software Foundation. If the Library as you 177 | received it does not specify a version number of the GNU Lesser 178 | General Public License, you may choose any version of the GNU Lesser 179 | General Public License ever published by the Free Software Foundation. 180 | 181 | If the Library as you received it specifies that a proxy can decide 182 | whether future versions of the GNU Lesser General Public License shall 183 | apply, that proxy's public statement of acceptance of any version is 184 | permanent authorization for you to choose that version for the 185 | Library. 186 | -------------------------------------------------------------------------------- /test/abbrtypes.ml: -------------------------------------------------------------------------------- 1 | (* Slacko's public interface doesn't let us easily construct Slacko.user and 2 | Slacko.channel values from JSON, and it doesn't let us extract strings from 3 | those values at all. Therefore, we copy the record type that use these and 4 | skip the problematic fields. *) 5 | 6 | (* Wrap Yojson.Safe.t so we don't have to keep providing printers for it. *) 7 | type json = Yojson.Safe.t [@@deriving yojson] 8 | 9 | let pp_json fmt json = Format.pp_print_string fmt (Yojson.Safe.to_string json) 10 | 11 | type abbr_authed_obj = { 12 | url : string; 13 | team : string; 14 | user : string; 15 | team_id : string; (* user_id: user; *) 16 | } 17 | [@@deriving make, show, yojson { strict = false }] 18 | 19 | let abbr_authed_obj (authed : Slacko.authed_obj) = 20 | { 21 | url = authed.Slacko.url; 22 | team = authed.Slacko.team; 23 | user = authed.Slacko.user; 24 | team_id = authed.Slacko.team_id; 25 | } 26 | 27 | type abbr_topic_obj = { 28 | value : string; 29 | (* creator: user; *) 30 | last_set : Timestamp.t; 31 | } 32 | [@@deriving show, yojson { strict = false }] 33 | 34 | let abbr_topic_obj (topic : Slacko.topic_obj) = 35 | { value = topic.Slacko.value; last_set = topic.Slacko.last_set } 36 | 37 | type abbr_channel_obj = { 38 | (* id: channel; *) 39 | name : string; 40 | is_channel : bool; 41 | created : Timestamp.t; 42 | (* creator: user; *) 43 | is_archived : bool; 44 | is_general : bool; 45 | is_member : bool; 46 | (* members: user list; *) 47 | topic : abbr_topic_obj; 48 | purpose : abbr_topic_obj; 49 | last_read : Timestamp.t option; [@default None] 50 | latest : json option; [@default None] 51 | unread_count : int option; [@default None] 52 | unread_count_display : int option; [@default None] 53 | num_members : int option; [@default None] 54 | } 55 | [@@deriving show, yojson { strict = false }] 56 | 57 | let abbr_channel_obj (chan : Slacko.channel_obj) = 58 | { 59 | name = chan.Slacko.name; 60 | is_channel = chan.Slacko.is_channel; 61 | created = chan.Slacko.created; 62 | is_archived = chan.Slacko.is_archived; 63 | is_general = chan.Slacko.is_general; 64 | is_member = chan.Slacko.is_member; 65 | topic = abbr_topic_obj chan.Slacko.topic; 66 | purpose = abbr_topic_obj chan.Slacko.purpose; 67 | last_read = chan.Slacko.last_read; 68 | latest = chan.Slacko.latest; 69 | unread_count = chan.Slacko.unread_count; 70 | unread_count_display = chan.Slacko.unread_count_display; 71 | num_members = chan.Slacko.num_members; 72 | } 73 | 74 | type abbr_channel_obj_list = abbr_channel_obj list [@@deriving show, yojson] 75 | 76 | type abbr_conversation_obj = { 77 | (* id: conversation; *) 78 | name : string; 79 | is_channel : bool; 80 | created : Timestamp.t; 81 | (* creator: user; *) 82 | is_archived : bool; 83 | is_general : bool; 84 | is_member : bool; 85 | (* members: user list; *) 86 | topic : abbr_topic_obj; 87 | purpose : abbr_topic_obj; 88 | last_read : Timestamp.t option; [@default None] 89 | (* latest: json option [@default None]; *) 90 | unread_count : int option; [@default None] 91 | unread_count_display : int option; [@default None] 92 | num_members : int option; [@default None] 93 | } 94 | [@@deriving show, yojson { strict = false }] 95 | 96 | let abbr_conversation_obj (conversation : Slacko.conversation_obj) = 97 | { 98 | name = conversation.Slacko.name; 99 | is_channel = conversation.Slacko.is_channel; 100 | created = conversation.Slacko.created; 101 | is_archived = conversation.Slacko.is_archived; 102 | is_general = conversation.Slacko.is_general; 103 | is_member = conversation.Slacko.is_member; 104 | topic = abbr_topic_obj conversation.Slacko.topic; 105 | purpose = abbr_topic_obj conversation.Slacko.purpose; 106 | last_read = conversation.Slacko.last_read; 107 | unread_count = conversation.Slacko.unread_count; 108 | unread_count_display = conversation.Slacko.unread_count_display; 109 | num_members = conversation.Slacko.num_members; 110 | } 111 | 112 | type abbr_conversation_obj_list = abbr_conversation_obj list [@@deriving show] 113 | 114 | type abbr_conversation_list_obj = { channels : abbr_conversation_obj list } 115 | [@@deriving show, yojson { strict = false }] 116 | 117 | let abbr_conversation_obj_list_of_yojson json = 118 | match abbr_conversation_list_obj_of_yojson json with 119 | | Ok obj -> Ok obj.channels 120 | | Error _ as err -> err 121 | 122 | type abbr_message_obj = { 123 | type' : string; [@key "type"] 124 | ts : Timestamp.t; 125 | (* user: user; *) 126 | text : string option; 127 | is_starred : bool option; [@default None] 128 | } 129 | [@@deriving show, yojson { strict = false }] 130 | 131 | let abbr_message_obj (message : Slacko.message_obj) = 132 | { 133 | type' = message.Slacko.type'; 134 | ts = message.Slacko.ts; 135 | text = message.Slacko.text; 136 | is_starred = message.Slacko.is_starred; 137 | } 138 | 139 | type abbr_history_obj = { 140 | latest : Timestamp.t option; [@default None] 141 | messages : abbr_message_obj list; 142 | has_more : bool; 143 | } 144 | [@@deriving show, yojson { strict = false }] 145 | 146 | let abbr_history_obj (history : Slacko.history_obj) = 147 | { 148 | latest = history.Slacko.latest; 149 | messages = List.map abbr_message_obj history.Slacko.messages; 150 | has_more = history.Slacko.has_more; 151 | } 152 | 153 | type abbr_user_obj = { 154 | (* id: user; *) 155 | name : string; 156 | deleted : bool; 157 | color : string option; [@default None] 158 | real_name : string option; [@default None] 159 | tz : string option; [@default None] 160 | tz_label : string option; [@default None] 161 | tz_offset : int; [@default 0] 162 | profile : json; 163 | is_admin : bool; [@default false] 164 | is_owner : bool; [@default false] 165 | is_primary_owner : bool; [@default false] 166 | is_restricted : bool; [@default false] 167 | is_ultra_restricted : bool; [@default false] 168 | is_bot : bool; 169 | has_files : bool; [@default false] 170 | } 171 | [@@deriving show, yojson { strict = false }] 172 | 173 | let abbr_user_obj (user : Slacko.user_obj) = 174 | { 175 | name = user.Slacko.name; 176 | deleted = user.Slacko.deleted; 177 | color = user.Slacko.color; 178 | real_name = user.Slacko.real_name; 179 | tz = user.Slacko.tz; 180 | tz_label = user.Slacko.tz_label; 181 | tz_offset = user.Slacko.tz_offset; 182 | profile = user.Slacko.profile; 183 | is_admin = user.Slacko.is_admin; 184 | is_owner = user.Slacko.is_owner; 185 | is_primary_owner = user.Slacko.is_primary_owner; 186 | is_restricted = user.Slacko.is_restricted; 187 | is_ultra_restricted = user.Slacko.is_ultra_restricted; 188 | is_bot = user.Slacko.is_bot; 189 | has_files = user.Slacko.has_files; 190 | } 191 | 192 | type abbr_users_list_obj = { members : abbr_user_obj list } 193 | [@@deriving of_yojson { strict = false }] 194 | 195 | type abbr_user_obj_list = abbr_user_obj list [@@deriving show] 196 | 197 | let abbr_user_obj_list_of_yojson json = 198 | match abbr_users_list_obj_of_yojson json with 199 | | Ok obj -> Ok obj.members 200 | | Error _ as err -> err 201 | 202 | type abbr_file_obj = { 203 | (* TODO file id type *) 204 | id : string; 205 | created : Timestamp.t; 206 | (* deprecated *) 207 | timestamp : Timestamp.t; 208 | name : string option; [@default None] 209 | title : string; 210 | mimetype : string; 211 | pretty_type : string; (* user: user; *) 212 | mode : string; 213 | editable : bool; 214 | is_external : bool; 215 | external_type : string; 216 | size : int; 217 | (* These two are deprecated and appear to be gone. *) 218 | (* url: string; *) 219 | (* url_download: string; *) 220 | url_private : string; 221 | url_private_download : string; 222 | thumb_64 : string option; [@default None] 223 | thunb_80 : string option; [@default None] 224 | thumb_360 : string option; [@default None] 225 | thumb_360_gif : string option; [@default None] 226 | thumb_360_w : int option; [@default None] 227 | thumb_360_h : int option; [@default None] 228 | permalink : string; 229 | edit_link : string option; [@default None] 230 | preview : string option; [@default None] 231 | preview_highlight : string option; [@default None] 232 | lines : int option; [@default None] 233 | lines_more : int option; [@default None] 234 | is_public : bool; 235 | (*public_url_shared: ???;*) 236 | (* channels: channel list; *) 237 | (* groups: group list; *) 238 | (* ims: conversation list; *) 239 | initial_comment : json option; [@default None] 240 | num_stars : int option; [@default None] 241 | } 242 | [@@deriving show, yojson { strict = false }] 243 | 244 | let abbr_file_obj (file : Slacko.file_obj) = 245 | { 246 | id = file.Slacko.id; 247 | created = file.Slacko.created; 248 | timestamp = file.Slacko.timestamp; 249 | name = file.Slacko.name; 250 | title = file.Slacko.title; 251 | mimetype = file.Slacko.mimetype; 252 | pretty_type = file.Slacko.pretty_type; 253 | mode = file.Slacko.mode; 254 | editable = file.Slacko.editable; 255 | is_external = file.Slacko.is_external; 256 | external_type = file.Slacko.external_type; 257 | size = file.Slacko.size; 258 | url_private = file.Slacko.url_private; 259 | url_private_download = file.Slacko.url_private_download; 260 | thumb_64 = file.Slacko.thumb_64; 261 | thunb_80 = file.Slacko.thunb_80; 262 | thumb_360 = file.Slacko.thumb_360; 263 | thumb_360_gif = file.Slacko.thumb_360_gif; 264 | thumb_360_w = file.Slacko.thumb_360_w; 265 | thumb_360_h = file.Slacko.thumb_360_h; 266 | permalink = file.Slacko.permalink; 267 | edit_link = file.Slacko.edit_link; 268 | preview = file.Slacko.preview; 269 | preview_highlight = file.Slacko.preview_highlight; 270 | lines = file.Slacko.lines; 271 | lines_more = file.Slacko.lines_more; 272 | is_public = file.Slacko.is_public; 273 | initial_comment = file.Slacko.initial_comment; 274 | num_stars = file.Slacko.num_stars; 275 | } 276 | 277 | type abbr_paging_obj = { count : int; total : int; page : int; pages : int } 278 | [@@deriving show, yojson { strict = false }] 279 | 280 | let abbr_paging_obj (paging : Slacko.paging_obj) = 281 | { 282 | count = paging.Slacko.count; 283 | total = paging.Slacko.total; 284 | page = paging.Slacko.page; 285 | pages = paging.Slacko.pages; 286 | } 287 | 288 | type abbr_files_list_obj = { 289 | files : abbr_file_obj list; 290 | paging : abbr_paging_obj; 291 | } 292 | [@@deriving show, yojson { strict = false }] 293 | 294 | let abbr_files_list_obj (files : Slacko.files_list_obj) = 295 | { 296 | files = List.map abbr_file_obj files.Slacko.files; 297 | paging = abbr_paging_obj files.Slacko.paging; 298 | } 299 | 300 | type abbr_group_obj = { 301 | (* id: group; *) 302 | name : string; 303 | is_group : bool; 304 | created : Timestamp.t; 305 | (* creator: user; *) 306 | is_archived : bool; 307 | (* members: user list; *) 308 | topic : abbr_topic_obj; 309 | purpose : abbr_topic_obj; 310 | is_open : bool option; [@default None] 311 | last_read : Timestamp.t option; [@default None] 312 | unread_count : int option; [@default None] 313 | unread_count_display : int option; [@default None] 314 | latest : json option; [@default None] 315 | } 316 | [@@deriving show, yojson { strict = false }] 317 | 318 | let abbr_group_obj (group : Slacko.group_obj) = 319 | { 320 | name = group.Slacko.name; 321 | is_group = group.Slacko.is_group; 322 | created = group.Slacko.created; 323 | is_archived = group.Slacko.is_archived; 324 | topic = abbr_topic_obj group.Slacko.topic; 325 | purpose = abbr_topic_obj group.Slacko.purpose; 326 | is_open = group.Slacko.is_open; 327 | last_read = group.Slacko.last_read; 328 | unread_count = group.Slacko.unread_count; 329 | unread_count_display = group.Slacko.unread_count_display; 330 | latest = group.Slacko.latest; 331 | } 332 | 333 | type abbr_group_obj_list = abbr_group_obj list [@@deriving show, yojson] 334 | 335 | type abbr_im_obj = { 336 | id : string; 337 | is_im : bool; 338 | (* user: user; *) 339 | created : Timestamp.t; 340 | is_user_deleted : bool; 341 | unread_count : int option; [@default None] 342 | unread_count_display : int option; [@default None] 343 | } 344 | [@@deriving show, yojson { strict = false }] 345 | 346 | let abbr_im_obj (im : Slacko.im_obj) = 347 | { 348 | id = im.Slacko.id; 349 | is_im = im.Slacko.is_im; 350 | created = im.Slacko.created; 351 | is_user_deleted = im.Slacko.is_user_deleted; 352 | unread_count = im.Slacko.unread_count; 353 | unread_count_display = im.Slacko.unread_count_display; 354 | } 355 | 356 | type abbr_im_obj_list = abbr_im_obj list [@@deriving show, yojson] 357 | -------------------------------------------------------------------------------- /test/test_slacko.ml: -------------------------------------------------------------------------------- 1 | open Lwt 2 | open OUnit2 3 | open Slounit 4 | open Abbrtypes 5 | 6 | let token = 7 | try Sys.getenv "SLACKO_TEST_TOKEN" with Not_found -> Fake_slack.valid_token 8 | 9 | let badtoken = "badtoken" 10 | 11 | (* If we have a non-default token, assume we want to talk to real slack. If 12 | not, use our local fake instead. *) 13 | let base_url = 14 | match token with 15 | | t when t = Fake_slack.valid_token -> Some "http://127.0.0.1:7357/api/" 16 | | _ -> ( 17 | print_endline 18 | ("NOTE: Because an API token has been provided, " 19 | ^ "tests will run against the real slack API."); 20 | try 21 | (* We may want to talk to a proxy or a different fake slack. *) 22 | let base_url = Sys.getenv "SLACKO_TEST_BASE_URL" in 23 | print_endline @@ "NOTE: Overriding slack base URL to " ^ base_url; 24 | Some base_url 25 | with Not_found -> None) 26 | 27 | let abbr_json abbr_of_yojson json = 28 | match abbr_of_yojson json with 29 | | Ok abbr -> abbr 30 | | Error err -> failwith @@ "Error parsing JSON: " ^ err 31 | 32 | let get_success = function 33 | | `Success obj -> obj 34 | | _ -> assert_failure "Unexpected failure." 35 | 36 | (* api_test *) 37 | 38 | let test_api_test_nodata _tctx = 39 | Slacko.api_test ?base_url () >|= get_success >|= fun json -> 40 | assert_equal ~printer:Yojson.Safe.to_string (`Assoc []) json 41 | 42 | let test_api_test_foo _tctx = 43 | Slacko.api_test ?base_url ~foo:"hello" () >|= get_success >|= fun json -> 44 | assert_equal ~printer:Yojson.Safe.to_string 45 | (`Assoc [ ("args", `Assoc [ ("foo", `String "hello") ]) ]) 46 | json 47 | 48 | let test_api_test_err _tctx = 49 | Slacko.api_test ?base_url ~error:"badthing" () >|= fun resp -> 50 | assert_equal (`Unhandled_error "badthing") resp 51 | 52 | let test_api_test_err_foo _tctx = 53 | Slacko.api_test ?base_url ~foo:"goodbye" ~error:"badthing" () >|= fun resp -> 54 | assert_equal (`Unhandled_error "badthing") resp 55 | 56 | let api_test_tests = 57 | fake_slack_tests "api_test" 58 | [ 59 | ("test_nodata", test_api_test_nodata); 60 | ("test_foo", test_api_test_foo); 61 | ("test_err", test_api_test_err); 62 | ("test_err_foo", test_api_test_err_foo); 63 | ] 64 | 65 | (* auth_test *) 66 | 67 | let test_auth_test_valid _tctx = 68 | let session = Slacko.start_session ?base_url token in 69 | Slacko.auth_test session >|= get_success >|= abbr_authed_obj >|= fun authed -> 70 | assert_equal ~printer:show_abbr_authed_obj 71 | (abbr_json abbr_authed_obj_of_yojson Fake_slack.authed_json) 72 | authed 73 | 74 | let test_auth_test_invalid _tctx = 75 | let session = Slacko.start_session ?base_url badtoken in 76 | Slacko.auth_test session >|= fun resp -> assert_equal `Invalid_auth resp 77 | 78 | let auth_test_tests = 79 | fake_slack_tests "test_auth" 80 | [ 81 | ("test_valid", test_auth_test_valid); 82 | ("test_invalid", test_auth_test_invalid); 83 | ] 84 | 85 | (* channels_archive *) 86 | 87 | let test_channels_archive_bad_auth _tctx = 88 | let session = Slacko.start_session ?base_url badtoken in 89 | let new_channel = Slacko.channel_of_string "#new_channel" in 90 | Slacko.channels_archive session new_channel >|= fun resp -> 91 | assert_equal `Invalid_auth resp 92 | 93 | let test_channels_archive_existing _tctx = 94 | let session = Slacko.start_session ?base_url token in 95 | let new_channel = Slacko.channel_of_string "archivable_channel" in 96 | Slacko.channels_archive session new_channel >|= fun resp -> 97 | assert_equal `Success resp 98 | 99 | let test_channels_archive_missing _tctx = 100 | let session = Slacko.start_session ?base_url token in 101 | let missing_channel = Slacko.channel_of_string "#missing_channel" in 102 | Slacko.channels_archive session missing_channel >|= fun resp -> 103 | assert_equal `Channel_not_found resp 104 | 105 | let test_channels_archive_archived _tctx = 106 | let session = Slacko.start_session ?base_url token in 107 | let archived_channel = Slacko.channel_of_string "archived_channel" in 108 | Slacko.channels_archive session archived_channel >|= fun resp -> 109 | assert_equal `Already_archived resp 110 | 111 | let test_channels_archive_general _tctx = 112 | let session = Slacko.start_session ?base_url token in 113 | let general = Slacko.channel_of_string "general" in 114 | Slacko.channels_archive session general >|= fun resp -> 115 | assert_equal `Cant_archive_general resp 116 | 117 | let channels_archive_tests = 118 | fake_slack_tests "channels_archive" 119 | [ 120 | ("test_bad_auth", test_channels_archive_bad_auth); 121 | ("test_existing", test_channels_archive_existing); 122 | ("test_missing", test_channels_archive_missing); 123 | ("test_archived", test_channels_archive_archived); 124 | ("test_general", test_channels_archive_general); 125 | ] 126 | 127 | (* channels_create *) 128 | 129 | let test_channels_create_bad_auth _tctx = 130 | let session = Slacko.start_session ?base_url badtoken in 131 | Slacko.channels_create session "#new_channel" >|= fun resp -> 132 | assert_equal `Invalid_auth resp 133 | 134 | let test_channels_create_new _tctx = 135 | let session = Slacko.start_session ?base_url token in 136 | Slacko.channels_create session "new_channel" 137 | >|= get_success >|= abbr_channel_obj 138 | >|= fun channel -> 139 | assert_equal ~printer:show_abbr_channel_obj 140 | (abbr_json abbr_channel_obj_of_yojson Fake_slack.new_channel_json) 141 | channel 142 | 143 | let test_channels_create_existing _tctx = 144 | let session = Slacko.start_session ?base_url token in 145 | Slacko.channels_create session "general" >|= fun resp -> 146 | assert_equal `Name_taken resp 147 | 148 | let channels_create_tests = 149 | fake_slack_tests "channels_create" 150 | [ 151 | ("test_bad_auth", test_channels_create_bad_auth); 152 | ("test_new", test_channels_create_new); 153 | ("test_existing", test_channels_create_existing); 154 | ] 155 | 156 | (* channels_history *) 157 | 158 | let test_channels_history_bad_auth _tctx = 159 | let session = Slacko.start_session ?base_url badtoken in 160 | let new_channel = Slacko.channel_of_string "#new_channel" in 161 | Slacko.channels_history session new_channel >|= fun resp -> 162 | assert_equal `Invalid_auth resp 163 | 164 | let test_channels_history_no_params _tctx = 165 | let session = Slacko.start_session ?base_url token in 166 | let random = Slacko.channel_of_string "random" in 167 | Slacko.channels_history session random >|= get_success >|= fun history -> 168 | assert_equal ~printer:show_abbr_history_obj 169 | (abbr_json abbr_history_obj_of_yojson Fake_slack.random_history_json) 170 | (abbr_history_obj history) 171 | 172 | let channels_history_tests = 173 | fake_slack_tests "channels_history" 174 | [ 175 | ("test_bad_auth", test_channels_history_bad_auth); 176 | ("test_no_params", test_channels_history_no_params); 177 | ] 178 | 179 | (* channels_info *) 180 | (* channels_invite *) 181 | (* channels_join *) 182 | (* channels_kick *) 183 | (* channels_leave *) 184 | 185 | (* conversations_list *) 186 | 187 | let test_conversations_list_bad_auth _tctx = 188 | let session = Slacko.start_session ?base_url badtoken in 189 | Slacko.conversations_list session >|= fun resp -> 190 | assert_equal `Invalid_auth resp 191 | 192 | let test_conversations_list _tctx = 193 | let session = Slacko.start_session ?base_url token in 194 | Slacko.conversations_list session 195 | >|= get_success 196 | >|= List.map abbr_conversation_obj 197 | >|= fun conversations -> 198 | assert_equal ~printer:show_abbr_conversation_obj_list 199 | (abbr_json abbr_conversation_obj_list_of_yojson 200 | Fake_slack.conversations_json) 201 | conversations 202 | 203 | let conversations_list_tests = 204 | fake_slack_tests "conversations_list" 205 | [ 206 | ("test_bad_auth", test_conversations_list_bad_auth); 207 | ("test", test_conversations_list); 208 | ] 209 | 210 | (* channels_mark *) 211 | (* channels_rename *) 212 | (* channels_set_purpose *) 213 | (* channels_set_topic *) 214 | (* channels_unarchive *) 215 | (* chat_delete *) 216 | (* chat_post_message *) 217 | (* chat_update *) 218 | (* emoji_list *) 219 | (* files_delete *) 220 | (* files_info *) 221 | 222 | (* files_list *) 223 | 224 | let test_files_list_bad_auth _tctx = 225 | let session = Slacko.start_session ?base_url badtoken in 226 | Slacko.files_list session >|= fun resp -> assert_equal `Invalid_auth resp 227 | 228 | let test_files_list _tctx = 229 | let session = Slacko.start_session ?base_url token in 230 | Slacko.files_list session >|= get_success >|= abbr_files_list_obj 231 | >|= fun files -> 232 | assert_equal ~printer:show_abbr_files_list_obj 233 | (abbr_json abbr_files_list_obj_of_yojson Fake_slack.files_json) 234 | files 235 | 236 | let files_list_tests = 237 | fake_slack_tests "files_list" 238 | [ ("test_bad_auth", test_files_list_bad_auth); ("test", test_files_list) ] 239 | 240 | (* files_upload *) 241 | (* groups_archive *) 242 | (* groups_close *) 243 | (* groups_create *) 244 | (* groups_create_child *) 245 | 246 | (* groups_history *) 247 | 248 | let test_groups_history_bad_auth _tctx = 249 | let session = Slacko.start_session ?base_url badtoken in 250 | let seekrit = Slacko.group_of_string "seekrit" in 251 | Slacko.groups_history session seekrit >|= fun resp -> 252 | assert_equal `Invalid_auth resp 253 | 254 | let test_groups_history_no_params _tctx = 255 | let session = Slacko.start_session ?base_url token in 256 | let seekrit = Slacko.group_of_string "seekrit" in 257 | Slacko.groups_history session seekrit >|= get_success >|= fun history -> 258 | assert_equal ~printer:show_abbr_history_obj 259 | (abbr_json abbr_history_obj_of_yojson Fake_slack.seekrit_history_json) 260 | (abbr_history_obj history) 261 | 262 | let groups_history_tests = 263 | fake_slack_tests "groups_history" 264 | [ 265 | ("test_bad_auth", test_groups_history_bad_auth); 266 | ("test_no_params", test_groups_history_no_params); 267 | ] 268 | 269 | (* groups_invite *) 270 | (* groups_kick *) 271 | (* groups_leave *) 272 | 273 | (* groups_list *) 274 | 275 | let test_groups_list_bad_auth _tctx = 276 | let session = Slacko.start_session ?base_url badtoken in 277 | Slacko.groups_list session >|= fun resp -> assert_equal `Invalid_auth resp 278 | 279 | let test_groups_list _tctx = 280 | let session = Slacko.start_session ?base_url token in 281 | Slacko.groups_list session >|= get_success >|= List.map abbr_group_obj 282 | >|= fun groups -> 283 | assert_equal ~printer:show_abbr_group_obj_list 284 | (abbr_json abbr_group_obj_list_of_yojson Fake_slack.groups_json) 285 | groups 286 | 287 | let groups_list_tests = 288 | fake_slack_tests "groups_list" 289 | [ ("test_bad_auth", test_groups_list_bad_auth); ("test", test_groups_list) ] 290 | 291 | (* groups_mark *) 292 | (* groups_open *) 293 | (* groups_rename *) 294 | (* groups_set_purpose *) 295 | (* groups_set_topic *) 296 | (* groups_unarchive *) 297 | (* im_close *) 298 | 299 | (* im_history *) 300 | 301 | let test_im_history_bad_auth _tctx = 302 | let session = Slacko.start_session ?base_url badtoken in 303 | let slackbot = Slacko.im_of_string Fake_slack.im_slackbot in 304 | Slacko.im_history session slackbot >|= fun resp -> 305 | assert_equal `Invalid_auth resp 306 | 307 | let test_im_history_no_params _tctx = 308 | let session = Slacko.start_session ?base_url token in 309 | let slackbot = Slacko.im_of_string Fake_slack.im_slackbot in 310 | Slacko.im_history session slackbot >|= get_success >|= fun history -> 311 | assert_equal ~printer:show_abbr_history_obj 312 | (abbr_json abbr_history_obj_of_yojson Fake_slack.slackbot_history_json) 313 | (abbr_history_obj history) 314 | 315 | let im_history_tests = 316 | fake_slack_tests "im_history" 317 | [ 318 | ("test_bad_auth", test_im_history_bad_auth); 319 | ("test_no_params", test_im_history_no_params); 320 | ] 321 | 322 | (* im_list *) 323 | 324 | let test_im_list_bad_auth _tctx = 325 | let session = Slacko.start_session ?base_url badtoken in 326 | Slacko.im_list session >|= fun resp -> assert_equal `Invalid_auth resp 327 | 328 | let test_im_list _tctx = 329 | let session = Slacko.start_session ?base_url token in 330 | Slacko.im_list session >|= get_success >|= List.map abbr_im_obj >|= fun ims -> 331 | assert_equal ~printer:show_abbr_im_obj_list 332 | (abbr_json abbr_im_obj_list_of_yojson Fake_slack.ims_json) 333 | ims 334 | 335 | let im_list_tests = 336 | fake_slack_tests "im_list" 337 | [ ("test_bad_auth", test_im_list_bad_auth); ("test", test_im_list) ] 338 | 339 | (* im_mark *) 340 | (* im_open *) 341 | (* oauth_access *) 342 | (* search_all *) 343 | (* search_files *) 344 | (* search_messages *) 345 | (* stars_list *) 346 | (* team_access_logs *) 347 | (* team_info *) 348 | (* users_get_presence *) 349 | (* users_info *) 350 | 351 | (* users_list *) 352 | 353 | let test_users_list_bad_auth _tctx = 354 | let session = Slacko.start_session ?base_url badtoken in 355 | Slacko.users_list session >|= fun resp -> assert_equal `Invalid_auth resp 356 | 357 | let test_users_list _tctx = 358 | let session = Slacko.start_session ?base_url token in 359 | Slacko.users_list session >|= get_success >|= List.map abbr_user_obj 360 | >|= fun users -> 361 | assert_equal ~printer:show_abbr_user_obj_list 362 | (abbr_json abbr_user_obj_list_of_yojson Fake_slack.users_json) 363 | users 364 | 365 | let users_list_tests = 366 | fake_slack_tests "users_list" 367 | [ ("test_bad_auth", test_users_list_bad_auth); ("test", test_users_list) ] 368 | 369 | (* users_set_active *) 370 | (* users_set_presence *) 371 | 372 | (* Gotta run them all! *) 373 | 374 | let suite = 375 | "tests" 376 | >::: [ 377 | api_test_tests; 378 | auth_test_tests; 379 | channels_archive_tests; 380 | channels_create_tests; 381 | channels_history_tests; 382 | (* channels_info_tests; *) 383 | (* channels_invite_tests; *) 384 | (* channels_join_tests; *) 385 | (* channels_kick_tests; *) 386 | (* channels_leave_tests; *) 387 | conversations_list_tests; 388 | (* channels_mark_tests; *) 389 | (* channels_rename_tests; *) 390 | (* channels_set_purpose_tests; *) 391 | (* channels_set_topic_tests; *) 392 | (* channels_unarchive_tests; *) 393 | (* chat_delete_tests; *) 394 | (* chat_post_message_tests; *) 395 | (* chat_update_tests; *) 396 | (* emoji_list_tests; *) 397 | (* files_delete_tests; *) 398 | (* files_info_tests; *) 399 | files_list_tests; 400 | (* files_upload_tests; *) 401 | (* groups_archive_tests; *) 402 | (* groups_close_tests; *) 403 | (* groups_create_tests; *) 404 | (* groups_create_child_tests; *) 405 | groups_history_tests; 406 | (* groups_invite_tests; *) 407 | (* groups_kick_tests; *) 408 | (* groups_leave_tests; *) 409 | groups_list_tests; 410 | (* groups_mark_tests; *) 411 | (* groups_open_tests; *) 412 | (* groups_rename_tests; *) 413 | (* groups_set_purpose_tests; *) 414 | (* groups_set_topic_tests; *) 415 | (* groups_unarchive_tests; *) 416 | (* im_close_tests; *) 417 | im_history_tests; 418 | im_list_tests; 419 | (* im_mark_tests; *) 420 | (* im_open_tests; *) 421 | (* oauth_access_tests; *) 422 | (* search_all_tests; *) 423 | (* search_files_tests; *) 424 | (* search_messages_tests; *) 425 | (* stars_list_tests; *) 426 | (* team_access_logs_tests; *) 427 | (* team_info_tests; *) 428 | (* users_get_presence_tests; *) 429 | (* users_info_tests; *) 430 | users_list_tests; 431 | (* users_set_active_tests; *) 432 | (* users_set_presence_tests; *) 433 | ] 434 | 435 | let () = run_test_tt_main suite 436 | -------------------------------------------------------------------------------- /src/lib/slacko.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Slacko - Binding to the Slack API 3 | * Copyright (C) 2014-2015 Marek Kubica 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 3.0 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file COPYING. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** An OCaml binding to the REST API of Slack. Each function triggers an 22 | HTTP request, so it returns immediately and returns an {!Lwt.t} value. 23 | 24 | To use the API you first need to either apply for a {!token} from Slack, 25 | or get one via the OAuth2 API. This string can then be converted into 26 | a {!session} by means of {!start_session}. With this {!session} most other 27 | methods from the binding can be called. The result of each API call is 28 | a variant type containing either the JSON result or an error type 29 | describing what kind of error occured. 30 | 31 | @author Marek Kubica *) 32 | 33 | (** {2 Types used in the binding} *) 34 | 35 | (** The binding exposes a number of errors that can happen. As not every 36 | function returns every possible API error, the possible errors are grouped 37 | into more convenient sets of errors that can be composed together to get 38 | the exact error types. 39 | *) 40 | 41 | type api_error = [ `Unhandled_error of string | `Unknown_error ] 42 | type parsed_api_error = [ `ParseFailure of string | api_error ] 43 | 44 | type auth_error = [ `Not_authed | `Invalid_auth | `Account_inactive ] 45 | (** API calls that require authentication (a {!session}) might fail with one of 46 | these errors, so functions that take {!session} arguments will return 47 | {e at least} these error variants. *) 48 | 49 | type timestamp_error = [ `Invalid_ts_latest | `Invalid_ts_oldest ] 50 | (** API calls that take {!timestamp} arguments can signal errors when the 51 | timestamp is invalid. The binding does its best to make sure that invalid 52 | timestamps are avoided. *) 53 | 54 | type channel_error = [ `Channel_not_found ] 55 | (** API calls that require {!channel} inputs can signal this error if the 56 | channel does not exist. *) 57 | 58 | type user_error = [ `User_not_found ] 59 | (** API calls that require {!user} inputs signal this error if the user 60 | was not found. *) 61 | 62 | type invite_error = [ `Cant_invite_self | `Cant_invite ] 63 | (** Inviting might fail because invitation is impossible for some reason or 64 | because attempting to invite oneself. *) 65 | 66 | type not_in_channel_error = [ `Not_in_channel ] 67 | (** Some API calls require the {!user} to be in {!channel} for the action to 68 | succeed, not meeting this requirement can raise this error. *) 69 | 70 | type already_in_channel_error = [ `Already_in_channel ] 71 | (** Some API calls require the {!user} not to be in {!channel} for the action 72 | to suceed. The opposite of {!not_in_channel_error}. *) 73 | 74 | type archive_error = [ `Is_archived ] 75 | (** Channels might be archived, so modification attempts will fail with this 76 | error. *) 77 | 78 | type name_error = [ `Name_taken ] 79 | (** When creating channels, names have to be unique, an attempt to create a 80 | duplicate one will result in this error. *) 81 | 82 | type kick_error = [ `Cant_kick_self ] 83 | (** Kick (in general) might fail, because kicking oneself is not supported. *) 84 | 85 | type channel_kick_error = 86 | [ kick_error | `Cant_kick_from_general | `Cant_kick_from_last_channel ] 87 | (** Kicking users from channels might fail, because channels have additional 88 | restrictions on kicking: users can't be kicked from the #general channel 89 | and they cannot be kicked from the last channel they are in. *) 90 | 91 | type restriction_error = [ `Restricted_action ] 92 | (** If an action was attempted that the user does not have permission to, 93 | this error is returned. *) 94 | 95 | type leave_general_error = [ `Cant_leave_general ] 96 | (** Leaving the #general channel is not supported by Slack, an attempt do 97 | do so will trigger this error. *) 98 | 99 | type message_error = [ `Cant_delete_message | `Message_not_found ] 100 | (** The {!message} might not exist or be impossible to delete for other 101 | reasons. *) 102 | 103 | type message_length_error = [ `Msg_too_long ] 104 | (** {!message} types, like {!topic} types might be too long to post. The Slack 105 | API does not specify the maximum message length, so Slacko can't make sure 106 | your messages stay below this limit, so everytime you post, this error can 107 | realistically happen. *) 108 | 109 | type attachments_error = [ `Too_many_attachments ] 110 | (** When posting a message with attachments, you may receive this error if you 111 | post too many. The Slack API documentation states that attempting to post a 112 | message with more than 100 attachments will fail with this error, but also 113 | that no message should ever have more than 20 attachments. Slacko doesn't 114 | check the number of attachments sent. *) 115 | 116 | type rate_error = [ `Rate_limited ] 117 | (** Doing too many API requests in a certain timespan might cause a rate 118 | limitation to be applied by Slack. This is the error that results in 119 | that case. *) 120 | 121 | type message_update_error = 122 | [ `Message_not_found | `Cant_update_message | `Edit_window_closed ] 123 | (** Updating a {!message} might fail because the message was not found, 124 | couldn't be updated for some reason or because the time in which a message 125 | can be edited has passed. *) 126 | 127 | type file_error = [ `File_not_found | `File_deleted ] 128 | (** Handling files can result in multiple problems: the file wasn't found in 129 | the first place or it might have been deleted in the maintime. *) 130 | 131 | type unknown_type_error = [ `Unknown_type ] 132 | (** This error shouldn't ever be returned but serves as a catch-all in case 133 | the Slack API returns a new, unknown error type that Slacko doesn't yet 134 | understand. *) 135 | 136 | type already_archived_error = [ `Already_archived ] 137 | (** When trying to archive something that was already archived before, this 138 | error is returned. *) 139 | 140 | type not_in_group_error = [ `Not_in_group ] 141 | (** Doing an action in a {!group} when not being part of the group can fail. *) 142 | 143 | (* Leaving the last {!channel} is not supported by Slack. *) 144 | type leave_last_channel_error = [ `Cant_leave_last_channel ] 145 | 146 | type last_member_error = [ `Last_member ] 147 | (** An error when the user is the last member and can't do what he planned to 148 | do because that would cause the {!channel} not to have members anymore. *) 149 | 150 | type oauth_error = 151 | [ `Invalid_client_id 152 | | `Bad_client_secret 153 | | `Invalid_code 154 | | `Bad_redirect_uri 155 | | `Unknown_error ] 156 | (** These errors might be returned when the exchange of oauth authorization 157 | for a token has failed. *) 158 | 159 | type presence_error = [ `Invalid_presence ] 160 | (** Setting an invalid presence information is not supported. *) 161 | 162 | type user_visibility_error = [ `User_not_visible ] 163 | (** User is not visible, so action cannot be performed on them. *) 164 | 165 | type invalid_name_error = [ `Invalid_name ] 166 | type bot_error = [ `User_is_bot ] 167 | 168 | type parsed_auth_error = [ parsed_api_error | auth_error ] 169 | (** API calls which require authentication will always return (at least) these 170 | error types. *) 171 | 172 | type topic_result = 173 | [ `Success of string 174 | | parsed_auth_error 175 | | channel_error 176 | | archive_error 177 | | not_in_channel_error 178 | | `User_is_restricted ] 179 | (** Setting topics or purposes will result either in a success or one of these 180 | errors. Convenience type composed of subtypes. *) 181 | 182 | type timestamp = Ptime.t 183 | (** Slack uses 6 decimal digit fixed point seconds since Epoch to represent 184 | message timestamps, which are also used to identify messages within a 185 | channel. Ptime provides an exact representation, allowing precise history 186 | queries and message identification. *) 187 | 188 | type session 189 | (** Sessions are required in the API for all actions that interact with 190 | *) 191 | 192 | type token = session 193 | (** {!token} is an alias for {!session} for backwards compatibility reasons. *) 194 | 195 | type topic 196 | (** The topic type represents a topic or a purpose message. Both are limited 197 | deliberately to have at most 250 UTF-8 encoded codepoints. *) 198 | 199 | type message 200 | (** The message represents a message to be posted. *) 201 | 202 | type channel 203 | (** A channel type, can be either a channel name (starting with a #) or a 204 | channel id. *) 205 | 206 | type conversation 207 | (** A channel-like container for a conversation used by the Conversations API. *) 208 | 209 | type im 210 | (** A type of an IM conversation *) 211 | 212 | type user 213 | (** An user, represented by either a user name or a user id. *) 214 | 215 | type bot 216 | (** A bot user, represented by a bot id *) 217 | 218 | type group 219 | (** A group, a private subset of users chatting together. *) 220 | 221 | (** A place one can post messages to. *) 222 | type chat = Channel of channel | Im of im | User of user | Group of group 223 | 224 | (** What criterion to use in search. *) 225 | type sort_criterion = Score | Timestamp 226 | 227 | (** Search result can be ordered in ascending or descending order. *) 228 | type sort_direction = Ascending | Descending 229 | 230 | (** Presence can either be active or away. *) 231 | type presence = Auto | Away 232 | 233 | type topic_obj = { value : string; creator : user; last_set : timestamp } 234 | (** A topic or purpose object. *) 235 | 236 | type user_obj = { 237 | id : user; 238 | name : string; 239 | deleted : bool; 240 | color : string option; 241 | real_name : string option; 242 | tz : string option; 243 | tz_label : string option; 244 | tz_offset : int; 245 | profile : Yojson.Safe.t; 246 | is_admin : bool; 247 | is_owner : bool; 248 | is_primary_owner : bool; 249 | is_restricted : bool; 250 | is_ultra_restricted : bool; 251 | is_bot : bool; 252 | has_files : bool; 253 | } 254 | (** Object representing lots of information about a Slack user. *) 255 | 256 | type group_obj = { 257 | id : group; 258 | name : string; 259 | is_group : bool; 260 | created : timestamp; 261 | creator : user; 262 | is_archived : bool; 263 | members : user list; 264 | topic : topic_obj; 265 | purpose : topic_obj; 266 | is_open : bool option; 267 | last_read : timestamp option; 268 | unread_count : int option; 269 | unread_count_display : int option; 270 | latest : Yojson.Safe.t option; 271 | } 272 | (** Object representing information about a Slack group. *) 273 | 274 | type channel_obj = { 275 | id : channel; 276 | name : string; 277 | is_channel : bool; 278 | created : timestamp; 279 | creator : user; 280 | is_archived : bool; 281 | is_general : bool; 282 | name_normalized : string; 283 | is_member : bool; 284 | members : user list; 285 | topic : topic_obj; 286 | purpose : topic_obj; 287 | last_read : timestamp option; 288 | latest : Yojson.Safe.t option; 289 | unread_count : int option; 290 | unread_count_display : int option; 291 | num_members : int option; 292 | } 293 | (** Object representing information about a Slack channel. *) 294 | 295 | type conversation_obj = { 296 | id : conversation; 297 | name : string; 298 | is_channel : bool; 299 | created : timestamp; 300 | creator : user; 301 | is_archived : bool; 302 | is_general : bool; 303 | name_normalized : string; 304 | is_member : bool; 305 | topic : topic_obj; 306 | purpose : topic_obj; 307 | last_read : timestamp option; 308 | latest : string option; 309 | unread_count : int option; 310 | unread_count_display : int option; 311 | num_members : int option; 312 | } 313 | (** Object representing information about a Slack channel. *) 314 | 315 | type field_obj = { title : string option; value : string; short : bool } 316 | (** Object representing a message attachment field. *) 317 | 318 | type attachment_obj = { 319 | fallback : string option; 320 | color : string option; 321 | pretext : string option; 322 | author_name : string option; 323 | author_link : string option; 324 | author_icon : string option; 325 | title : string option; 326 | title_link : string option; 327 | text : string option; 328 | fields : field_obj list option; 329 | image_url : string option; 330 | thumb_url : string option; 331 | footer : string option; 332 | footer_icon : string option; 333 | ts : timestamp option; 334 | mrkdwn_in : string list option; 335 | } 336 | (** Object representing a message attachment. *) 337 | 338 | type message_obj = { 339 | type' : string; 340 | ts : timestamp; 341 | user : user option; 342 | bot_id : bot option; 343 | text : string option; 344 | is_starred : bool option; 345 | } 346 | (** Object representing a message. Can be of a number of types. *) 347 | 348 | (* The message history of a channel or group conversation. *) 349 | type history_obj = { 350 | latest : timestamp option; 351 | messages : message_obj list; 352 | has_more : bool; 353 | } 354 | 355 | type authed_obj = { 356 | url : string; 357 | team : string; 358 | user : string; 359 | team_id : string; 360 | user_id : user; 361 | } 362 | (** Authentication information from the current user. *) 363 | 364 | type channel_leave_obj = { not_in_channel : bool option } 365 | (** Response to a channel leave request. *) 366 | 367 | type channel_rename_obj = { 368 | id : channel; 369 | is_channel : bool; 370 | name : string; 371 | created : timestamp; 372 | } 373 | (** Response to renaming of a channel. *) 374 | 375 | type chat_obj = { ts : timestamp; chat : chat; text : string option } 376 | 377 | type emoji = string * string 378 | (** A single emoji. *) 379 | 380 | type chat_close_obj = { no_op : bool option; already_closed : bool option } 381 | 382 | type groups_invite_obj = { already_in_group : bool option; group : group_obj } 383 | (** Response to a channel invite. *) 384 | 385 | type groups_open_obj = { no_op : bool option; already_open : bool option } 386 | (** Response to opening a group. *) 387 | 388 | type groups_rename_obj = { 389 | id : channel; 390 | is_group : bool; 391 | name : string; 392 | created : timestamp; 393 | } 394 | (** Response to rename of a group *) 395 | 396 | type im_obj = { 397 | id : string; 398 | is_im : bool; 399 | user : user; 400 | created : timestamp; 401 | is_user_deleted : bool; 402 | is_open : bool option; 403 | last_read : timestamp option; 404 | unread_count : int option; 405 | unread_count_display : int option; 406 | } 407 | (** Information about a direct im with a person. *) 408 | 409 | type im_channel_obj = { id : string } 410 | 411 | type im_open_obj = { 412 | no_op : bool option; 413 | already_open : bool option; 414 | channel : im_channel_obj; 415 | } 416 | (** Information about an direct im channel. *) 417 | 418 | type oauth_obj = { access_token : string; scope : string } 419 | (** When requesting an OAuth token, you get a token and the scope for which 420 | this token is valid. *) 421 | 422 | type comment_obj = { 423 | id : string; 424 | timestamp : timestamp; 425 | user : user; 426 | comment : string; 427 | } 428 | (** Represents a comment on an item. *) 429 | 430 | type paging_obj = { count : int; total : int; page : int; pages : int } 431 | (** Paging information for requests that might have multi page results. *) 432 | 433 | type file_obj = { 434 | (* TODO file id type *) 435 | id : string; 436 | created : timestamp; 437 | (* deprecated *) 438 | timestamp : timestamp; 439 | name : string option; 440 | title : string; 441 | mimetype : string; 442 | pretty_type : string; 443 | user : user; 444 | mode : string; 445 | editable : bool; 446 | is_external : bool; 447 | external_type : string; 448 | size : int; 449 | url_private : string; 450 | url_private_download : string; 451 | thumb_64 : string option; 452 | thunb_80 : string option; 453 | thumb_360 : string option; 454 | thumb_360_gif : string option; 455 | thumb_360_w : int option; 456 | thumb_360_h : int option; 457 | permalink : string; 458 | edit_link : string option; 459 | preview : string option; 460 | preview_highlight : string option; 461 | lines : int option; 462 | lines_more : int option; 463 | is_public : bool; 464 | (*public_url_shared: ???;*) 465 | channels : channel list; 466 | groups : group list; 467 | ims : im list; 468 | initial_comment : Yojson.Safe.t option; 469 | num_stars : int option; 470 | } 471 | (** Information about a file. *) 472 | 473 | type files_info_obj = { 474 | file : file_obj; 475 | comments : comment_obj list; 476 | paging : paging_obj; 477 | } 478 | (** Metainformation about a file. *) 479 | 480 | type files_list_obj = { files : file_obj list; paging : paging_obj } 481 | (** A list of files. *) 482 | 483 | type stars_list_obj = { items : Yojson.Safe.t list; paging : paging_obj } 484 | (** Information about starred items. *) 485 | 486 | type message_search_obj = { 487 | total : int; 488 | paging : paging_obj; 489 | matches : message_obj list; 490 | } 491 | 492 | type file_search_obj = { 493 | total : int; 494 | paging : paging_obj; 495 | matches : file_obj list; 496 | } 497 | 498 | type search_obj = { 499 | query : string; 500 | messages : message_search_obj option; 501 | files : file_search_obj option; 502 | } 503 | 504 | type team_obj = { 505 | id : string; 506 | name : string; 507 | domain : string; 508 | email_domain : string; 509 | icon : Yojson.Safe.t; 510 | } 511 | 512 | type login_obj = { 513 | user_id : user; 514 | username : string; 515 | date_first : timestamp; 516 | date_last : timestamp; 517 | count : int; 518 | ip : string; 519 | user_agent : string; 520 | isp : string; 521 | country : string; 522 | region : string; 523 | } 524 | 525 | type team_access_log_obj = { logins : login_obj list; paging : paging_obj } 526 | 527 | type history_result = 528 | [ `Success of history_obj 529 | | parsed_auth_error 530 | | channel_error 531 | | timestamp_error ] 532 | (** Return value of a history related request. *) 533 | 534 | (** {2 Type construction helper functions} *) 535 | 536 | (** To build the types required in the API calls, you can use these helper 537 | functions. *) 538 | 539 | val start_session : ?base_url:string -> string -> session 540 | (** Create a session from a token string and an optional base_url. *) 541 | 542 | val token_of_string : string -> session 543 | [@@ocaml.deprecated "Please use 'start_session' instead."] 544 | (** Deprecated wrapper for backcompat. *) 545 | 546 | val field : ?title:string -> ?short:bool -> string -> field_obj 547 | 548 | val attachment : 549 | ?fallback:string -> 550 | ?color:string -> 551 | ?pretext:string -> 552 | ?author_name:string -> 553 | ?author_link:string -> 554 | ?author_icon:string -> 555 | ?title:string -> 556 | ?title_link:string -> 557 | ?text:string -> 558 | ?fields:field_obj list -> 559 | ?image_url:string -> 560 | ?thumb_url:string -> 561 | ?footer:string -> 562 | ?footer_icon:string -> 563 | ?ts:timestamp -> 564 | ?mrkdwn_in:string list -> 565 | unit -> 566 | attachment_obj 567 | 568 | val message_of_string : string -> message 569 | (** Build a message from a string. *) 570 | 571 | val topic_of_string : string -> topic option 572 | (** Build a topic out of a string. {!topic} types are also used to 573 | set purposes. Also validates the length of the topic, since Slack has 574 | a 250 UTF-8 codepoint length limit on purposes and topics. *) 575 | 576 | val topic_of_string_exn : string -> topic 577 | (** Same as {!topic_of_string} but throws an exception if it fails to convert 578 | the text data into a {!topic}. *) 579 | 580 | val group_of_string : string -> group 581 | (** Construct a group out of a given string. This can be either a group id, 582 | starting with capital 'G' character which is the preferred way or it can 583 | be a group name for convenience. In the latter case, each API call with 584 | requires a group will perform an additional request to determine the group 585 | id from the name. *) 586 | 587 | val user_of_string : string -> user 588 | (** Constructs a user out of a given string. The string can either be an user 589 | id starting with a capital 'U' which is the preferred way or it can be a 590 | simple user name in which case every API call will look up the user name 591 | to an id in an additional request. *) 592 | 593 | val bot_of_string : string -> bot 594 | 595 | val channel_of_string : string -> channel 596 | (** Constructs a channel out of a given string. Can either be a channel id 597 | starting with a capital 'C' which is the preferred way or a channel name 598 | starting with a '#'. If a channel name was provided, each consecutive API 599 | call using it will first need to resolve the channel name into a channel 600 | id by means of an additional request. *) 601 | 602 | val im_of_string : string -> im 603 | (** Create a im type out of a given string. The string is usually 604 | starting with a capital 'D' and represents an IM im channel. *) 605 | 606 | (** {2 Slack API calls} *) 607 | 608 | val api_test : 609 | ?base_url:string -> 610 | ?foo:string -> 611 | ?error:string -> 612 | unit -> 613 | [ `Success of Yojson.Safe.t | api_error ] Lwt.t 614 | (** Checks API calling code. 615 | @param base_url If set, overrides the Slack API base URL. 616 | @param foo A dummy value that will be returned by the API. 617 | @param error If set, will return a specific kind of error. *) 618 | 619 | val auth_test : session -> [ `Success of authed_obj | parsed_auth_error ] Lwt.t 620 | (** Checks authentication & identity. 621 | @param session The session containing the authentication token. *) 622 | 623 | val channels_archive : 624 | session -> 625 | channel -> 626 | [ `Success 627 | | parsed_auth_error 628 | | channel_error 629 | | already_archived_error 630 | | `Cant_archive_general 631 | | `Last_restricted_channel 632 | | restriction_error 633 | | `User_is_restricted 634 | | bot_error ] 635 | Lwt.t 636 | (** Archives a channel. *) 637 | 638 | val channels_create : 639 | session -> 640 | string -> 641 | [ `Success of channel_obj 642 | | parsed_auth_error 643 | | name_error 644 | | `User_is_restricted 645 | | bot_error ] 646 | Lwt.t 647 | (** Creates a channel. *) 648 | 649 | val channels_history : 650 | session -> 651 | ?latest:timestamp -> 652 | ?oldest:timestamp -> 653 | ?count:int -> 654 | ?inclusive:bool -> 655 | channel -> 656 | history_result Lwt.t 657 | (** Fetches history of messages and events from a channel. 658 | @param session The session containing the authentication token. 659 | @param latest The newest message from history to be returned. 660 | @param oldest The oldest message from history to be returned. 661 | @param count The number of messages to be returned. 662 | @param inclusive Include messages with latest or oldest timestamp in results. 663 | @param channel The Slack channel from which to get the history. *) 664 | 665 | val channels_info : 666 | session -> 667 | channel -> 668 | [ `Success of channel_obj | parsed_auth_error | channel_error ] Lwt.t 669 | (** Gets information about a channel. *) 670 | 671 | val channels_invite : 672 | session -> 673 | channel -> 674 | user -> 675 | [ `Success of channel_obj 676 | | parsed_auth_error 677 | | channel_error 678 | | user_error 679 | | invite_error 680 | | not_in_channel_error 681 | | already_in_channel_error 682 | | archive_error 683 | | `User_is_ultra_restricted 684 | | bot_error ] 685 | Lwt.t 686 | (** Invites a user to a channel. *) 687 | 688 | val channels_join : 689 | session -> 690 | channel -> 691 | [ `Success of channel_obj 692 | | parsed_auth_error 693 | | channel_error 694 | | name_error 695 | | archive_error 696 | | `User_is_restricted 697 | | bot_error ] 698 | Lwt.t 699 | (** Joins a channel, creating it if needed. *) 700 | 701 | val channels_kick : 702 | session -> 703 | channel -> 704 | user -> 705 | [ `Success 706 | | parsed_auth_error 707 | | channel_error 708 | | user_error 709 | | channel_kick_error 710 | | not_in_channel_error 711 | | restriction_error 712 | | `User_is_restricted 713 | | bot_error ] 714 | Lwt.t 715 | (** Removes a user from a channel. *) 716 | 717 | val channels_leave : 718 | session -> 719 | channel -> 720 | [ `Success of channel_leave_obj 721 | | parsed_auth_error 722 | | channel_error 723 | | archive_error 724 | | leave_general_error 725 | | `User_is_restricted 726 | | bot_error ] 727 | Lwt.t 728 | (** Leaves a channel. *) 729 | 730 | val conversations_list : 731 | ?exclude_archived:bool -> 732 | session -> 733 | [ `Success of conversation_obj list | parsed_auth_error ] Lwt.t 734 | (** Lists all channels in a Slack team. *) 735 | 736 | val channels_mark : 737 | session -> 738 | channel -> 739 | timestamp -> 740 | [ `Success 741 | | parsed_auth_error 742 | | channel_error 743 | | archive_error 744 | | not_in_channel_error ] 745 | Lwt.t 746 | (** Sets the read cursor in a channel. *) 747 | 748 | val channels_rename : 749 | session -> 750 | channel -> 751 | string -> 752 | [ `Success of channel_rename_obj 753 | | parsed_auth_error 754 | | channel_error 755 | | not_in_channel_error 756 | | name_error 757 | | invalid_name_error 758 | | `Not_authorized 759 | | `User_is_restricted 760 | | bot_error ] 761 | Lwt.t 762 | (** Renames a team channel. *) 763 | 764 | val channels_set_purpose : session -> channel -> topic -> topic_result Lwt.t 765 | (** Sets the purpose for a channel. *) 766 | 767 | val channels_set_topic : session -> channel -> topic -> topic_result Lwt.t 768 | (** Sets the topic for a channel. *) 769 | 770 | val channels_unarchive : 771 | session -> 772 | channel -> 773 | [ `Success 774 | | parsed_auth_error 775 | | channel_error 776 | | `Not_archived 777 | | `User_is_restricted 778 | | bot_error ] 779 | Lwt.t 780 | (** Unarchives a channel. *) 781 | 782 | val chat_delete : 783 | session -> 784 | timestamp -> 785 | chat -> 786 | [ `Success of chat_obj | parsed_auth_error | channel_error | message_error ] 787 | Lwt.t 788 | (** Deletes a message. *) 789 | 790 | val chat_post_message : 791 | session -> 792 | chat -> 793 | ?as_user:bool -> 794 | ?link_names:bool -> 795 | ?mrkdwn:bool -> 796 | ?reply_broadcast:bool -> 797 | ?thread_ts:timestamp -> 798 | ?unfurl_links:bool -> 799 | ?unfurl_media:bool -> 800 | ?username:string -> 801 | ?parse:string -> 802 | ?icon_url:string -> 803 | ?icon_emoji:string -> 804 | ?attachments:attachment_obj list -> 805 | message -> 806 | [ `Success of chat_obj 807 | | parsed_auth_error 808 | | channel_error 809 | | archive_error 810 | | message_length_error 811 | | attachments_error 812 | | rate_error 813 | | bot_error ] 814 | Lwt.t 815 | (** Sends a message to a channel. *) 816 | 817 | val chat_update : 818 | session -> 819 | timestamp -> 820 | chat -> 821 | ?as_user:bool -> 822 | ?attachments:attachment_obj list -> 823 | ?link_names:bool -> 824 | ?parse:string -> 825 | message -> 826 | [ `Success of chat_obj 827 | | parsed_auth_error 828 | | channel_error 829 | | message_update_error 830 | | message_length_error 831 | | attachments_error ] 832 | Lwt.t 833 | (** Updates a message. *) 834 | 835 | val emoji_list : session -> [ `Success of emoji list | parsed_auth_error ] Lwt.t 836 | (** Lists custom emoji for a team. *) 837 | 838 | val files_delete : 839 | session -> 840 | string -> 841 | [ `Success | parsed_auth_error | `Cant_delete_file | file_error | bot_error ] 842 | Lwt.t 843 | 844 | val files_info : 845 | session -> 846 | ?count:int -> 847 | ?page:int -> 848 | string -> 849 | [ `Success of files_info_obj | parsed_auth_error | file_error | bot_error ] 850 | Lwt.t 851 | (** Gets information about a team file. *) 852 | 853 | val files_list : 854 | ?user:user -> 855 | ?ts_from:timestamp -> 856 | ?ts_to:timestamp -> 857 | ?types:string -> 858 | ?count:int -> 859 | ?page:int -> 860 | session -> 861 | [ `Success of files_list_obj 862 | | parsed_auth_error 863 | | user_error 864 | | unknown_type_error 865 | | bot_error ] 866 | Lwt.t 867 | (** Lists & filters team files. *) 868 | 869 | val files_upload : 870 | session -> 871 | ?filetype:string -> 872 | ?filename:string -> 873 | ?title:string -> 874 | ?initial_comment:string -> 875 | ?channels:string -> 876 | Cohttp_lwt.Body.t -> 877 | [ `Success of file_obj | parsed_auth_error | bot_error ] Lwt.t 878 | (** Uploads or creates a file. *) 879 | 880 | val groups_archive : 881 | session -> 882 | group -> 883 | [ `Success 884 | | parsed_auth_error 885 | | channel_error 886 | | already_archived_error 887 | | `Group_contains_others 888 | | `Last_restricted_channel 889 | | restriction_error 890 | | `User_is_ultra_restricted 891 | | bot_error ] 892 | Lwt.t 893 | (** Archives a private group. *) 894 | 895 | val groups_close : 896 | session -> 897 | group -> 898 | [ `Success of chat_close_obj | parsed_auth_error | channel_error ] Lwt.t 899 | (** Closes a private group. *) 900 | 901 | val groups_create : 902 | session -> 903 | group -> 904 | [ `Success of group_obj 905 | | parsed_auth_error 906 | | name_error 907 | | restriction_error 908 | | `User_is_ultra_restricted 909 | | bot_error ] 910 | Lwt.t 911 | (** Creates a private group. *) 912 | 913 | val groups_create_child : 914 | session -> 915 | group -> 916 | [ `Success of group_obj 917 | | parsed_auth_error 918 | | channel_error 919 | | already_archived_error 920 | | restriction_error 921 | | `User_is_ultra_restricted 922 | | bot_error ] 923 | Lwt.t 924 | (** Clones and archives a private group. *) 925 | 926 | val groups_history : 927 | session -> 928 | ?latest:timestamp -> 929 | ?oldest:timestamp -> 930 | ?count:int -> 931 | ?inclusive:bool -> 932 | group -> 933 | history_result Lwt.t 934 | (** Fetches history of messages and events from a private group. *) 935 | 936 | val groups_invite : 937 | session -> 938 | group -> 939 | user -> 940 | [ `Success of groups_invite_obj 941 | | parsed_auth_error 942 | | channel_error 943 | | user_error 944 | | invite_error 945 | | archive_error 946 | | `User_is_ultra_restricted 947 | | bot_error ] 948 | Lwt.t 949 | (** Invites a user to a private group. *) 950 | 951 | val groups_kick : 952 | session -> 953 | group -> 954 | user -> 955 | [ `Success 956 | | parsed_auth_error 957 | | channel_error 958 | | user_error 959 | | kick_error 960 | | not_in_group_error 961 | | restriction_error 962 | | `User_is_restricted 963 | | bot_error ] 964 | Lwt.t 965 | (** Removes a user from a private group. *) 966 | 967 | val groups_leave : 968 | session -> 969 | group -> 970 | [ `Success 971 | | parsed_auth_error 972 | | channel_error 973 | | archive_error 974 | | leave_last_channel_error 975 | | last_member_error 976 | | `User_is_ultra_restricted 977 | | bot_error ] 978 | Lwt.t 979 | (** Leaves a private group. *) 980 | 981 | val groups_list : 982 | ?exclude_archived:bool -> 983 | session -> 984 | [ `Success of group_obj list | parsed_auth_error ] Lwt.t 985 | (** Lists private groups that the calling user has access to. *) 986 | 987 | val groups_mark : 988 | session -> 989 | group -> 990 | timestamp -> 991 | [ `Success 992 | | parsed_auth_error 993 | | channel_error 994 | | archive_error 995 | | not_in_channel_error ] 996 | Lwt.t 997 | (** Sets the read cursor in a private group. *) 998 | 999 | val groups_open : 1000 | session -> 1001 | group -> 1002 | [ `Success of groups_open_obj | parsed_auth_error | channel_error ] Lwt.t 1003 | (** Opens a private group. *) 1004 | 1005 | val groups_rename : 1006 | session -> 1007 | group -> 1008 | string -> 1009 | [ `Success of groups_rename_obj 1010 | | parsed_auth_error 1011 | | channel_error 1012 | | name_error 1013 | | invalid_name_error 1014 | | `User_is_restricted 1015 | | bot_error ] 1016 | Lwt.t 1017 | (** Renames a private group. *) 1018 | 1019 | val groups_set_purpose : session -> group -> topic -> topic_result Lwt.t 1020 | (** Sets the purpose for a private group. *) 1021 | 1022 | val groups_set_topic : session -> group -> topic -> topic_result Lwt.t 1023 | (** Sets the topic for a private group. *) 1024 | 1025 | val groups_unarchive : 1026 | session -> 1027 | group -> 1028 | [ `Success 1029 | | parsed_auth_error 1030 | | channel_error 1031 | | `Not_archived 1032 | | `User_is_restricted 1033 | | bot_error ] 1034 | Lwt.t 1035 | (** Unarchives a private group. *) 1036 | 1037 | val im_close : 1038 | session -> 1039 | im -> 1040 | [ `Success of chat_close_obj 1041 | | parsed_auth_error 1042 | | channel_error 1043 | | `User_does_not_own_channel ] 1044 | Lwt.t 1045 | (** Close a direct message channel. *) 1046 | 1047 | val im_history : 1048 | session -> 1049 | ?latest:timestamp -> 1050 | ?oldest:timestamp -> 1051 | ?count:int -> 1052 | ?inclusive:bool -> 1053 | im -> 1054 | history_result Lwt.t 1055 | (** Fetches history of messages and events from direct message channel. *) 1056 | 1057 | val im_list : session -> [ `Success of im_obj list | parsed_auth_error ] Lwt.t 1058 | (** Lists direct message channels for the calling user. *) 1059 | 1060 | val im_mark : 1061 | session -> 1062 | im -> 1063 | timestamp -> 1064 | [ `Success | parsed_auth_error | channel_error | not_in_channel_error ] Lwt.t 1065 | (** Sets the read cursor in a direct message channel. *) 1066 | 1067 | val im_open : 1068 | session -> 1069 | user -> 1070 | [ `Success of im_open_obj 1071 | | parsed_auth_error 1072 | | user_error 1073 | | user_visibility_error ] 1074 | Lwt.t 1075 | (** Opens a direct message channel. *) 1076 | 1077 | val oauth_access : 1078 | ?base_url:string -> 1079 | string -> 1080 | string -> 1081 | ?redirect_url:string -> 1082 | string -> 1083 | [ `Success of oauth_obj | `ParseFailure of string | oauth_error ] Lwt.t 1084 | (** Exchanges a temporary OAuth code for an API session. *) 1085 | 1086 | val search_all : 1087 | session -> 1088 | ?sort:sort_criterion -> 1089 | ?sort_dir:sort_direction -> 1090 | ?highlight:bool -> 1091 | ?count:int -> 1092 | ?page:int -> 1093 | string -> 1094 | [ `Success of search_obj | parsed_auth_error | bot_error ] Lwt.t 1095 | (** Searches for messages and files matching a query. *) 1096 | 1097 | val search_files : 1098 | session -> 1099 | ?sort:sort_criterion -> 1100 | ?sort_dir:sort_direction -> 1101 | ?highlight:bool -> 1102 | ?count:int -> 1103 | ?page:int -> 1104 | string -> 1105 | [ `Success of search_obj | parsed_auth_error | bot_error ] Lwt.t 1106 | (** Searches for files matching a query. *) 1107 | 1108 | val search_messages : 1109 | session -> 1110 | ?sort:sort_criterion -> 1111 | ?sort_dir:sort_direction -> 1112 | ?highlight:bool -> 1113 | ?count:int -> 1114 | ?page:int -> 1115 | string -> 1116 | [ `Success of search_obj | parsed_auth_error | bot_error ] Lwt.t 1117 | (** Searches for messages matching a query. *) 1118 | 1119 | val stars_list : 1120 | ?user:user -> 1121 | ?count:int -> 1122 | ?page:int -> 1123 | session -> 1124 | [ `Success of stars_list_obj | parsed_auth_error | user_error | bot_error ] 1125 | Lwt.t 1126 | (** Lists stars for a user. *) 1127 | 1128 | val team_access_logs : 1129 | ?count:int -> 1130 | ?page:int -> 1131 | session -> 1132 | [ `Success of team_access_log_obj 1133 | | parsed_auth_error 1134 | | `Paid_only 1135 | | bot_error ] 1136 | Lwt.t 1137 | (** Gets the access logs for the current team. *) 1138 | 1139 | val team_info : 1140 | session -> [ `Success of team_obj | parsed_auth_error | bot_error ] Lwt.t 1141 | (** Gets information about the current team. *) 1142 | 1143 | val users_get_presence : 1144 | session -> 1145 | user -> 1146 | [ `Success of presence | user_error | parsed_auth_error ] Lwt.t 1147 | (** Gets user presence information. *) 1148 | 1149 | val users_info : 1150 | session -> 1151 | user -> 1152 | [ `Success of user_obj 1153 | | parsed_auth_error 1154 | | user_error 1155 | | user_visibility_error ] 1156 | Lwt.t 1157 | (** Gets information about a user. *) 1158 | 1159 | val users_list : 1160 | session -> [ `Success of user_obj list | parsed_auth_error ] Lwt.t 1161 | (** Lists all users in a Slack team. *) 1162 | 1163 | val users_set_active : 1164 | session -> [ `Success | parsed_auth_error | bot_error ] Lwt.t 1165 | (** Marks a user as active. *) 1166 | 1167 | val users_set_presence : 1168 | session -> presence -> [ `Success | parsed_auth_error | presence_error ] Lwt.t 1169 | (** Manually sets user presence. *) 1170 | -------------------------------------------------------------------------------- /src/lib/slacko.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Slacko - Binding to the Slack API 3 | * Copyright (C) 2014-2016 Marek Kubica 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 3.0 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file COPYING. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | open Lwt.Infix 22 | open Lwt.Syntax 23 | module Cohttp_unix = Cohttp_lwt_unix 24 | module Cohttp_body = Cohttp_lwt.Body 25 | 26 | type api_error = [ `Unhandled_error of string | `Unknown_error ] 27 | type parsed_api_error = [ `ParseFailure of string | api_error ] 28 | type auth_error = [ `Not_authed | `Invalid_auth | `Account_inactive ] 29 | type timestamp_error = [ `Invalid_ts_latest | `Invalid_ts_oldest ] 30 | type channel_error = [ `Channel_not_found ] 31 | type user_error = [ `User_not_found ] 32 | type invite_error = [ `Cant_invite_self | `Cant_invite ] 33 | type not_in_channel_error = [ `Not_in_channel ] 34 | type already_in_channel_error = [ `Already_in_channel ] 35 | type archive_error = [ `Is_archived ] 36 | type name_error = [ `Name_taken ] 37 | type kick_error = [ `Cant_kick_self ] 38 | 39 | type channel_kick_error = 40 | [ kick_error | `Cant_kick_from_general | `Cant_kick_from_last_channel ] 41 | 42 | type restriction_error = [ `Restricted_action ] 43 | type leave_general_error = [ `Cant_leave_general ] 44 | type message_error = [ `Cant_delete_message | `Message_not_found ] 45 | type message_length_error = [ `Msg_too_long ] 46 | type attachments_error = [ `Too_many_attachments ] 47 | type rate_error = [ `Rate_limited ] 48 | 49 | type message_update_error = 50 | [ `Message_not_found | `Cant_update_message | `Edit_window_closed ] 51 | 52 | type file_error = [ `File_not_found | `File_deleted ] 53 | type unknown_type_error = [ `Unknown_type ] 54 | type already_archived_error = [ `Already_archived ] 55 | type not_in_group_error = [ `Not_in_group ] 56 | type leave_last_channel_error = [ `Cant_leave_last_channel ] 57 | type last_member_error = [ `Last_member ] 58 | 59 | type oauth_error = 60 | [ `Invalid_client_id 61 | | `Bad_client_secret 62 | | `Invalid_code 63 | | `Bad_redirect_uri 64 | | `Unknown_error ] 65 | 66 | type presence_error = [ `Invalid_presence ] 67 | type user_visibility_error = [ `User_not_visible ] 68 | type invalid_name_error = [ `Invalid_name ] 69 | type bot_error = [ `User_is_bot ] 70 | type parsed_auth_error = [ parsed_api_error | auth_error ] 71 | 72 | type topic_result = 73 | [ `Success of string 74 | | parsed_auth_error 75 | | channel_error 76 | | archive_error 77 | | not_in_channel_error 78 | | `User_is_restricted ] 79 | 80 | type timestamp = Ptime.t 81 | 82 | type session = { 83 | base_url : string; 84 | token : string; (* Mutable id cache goes here? *) 85 | } 86 | 87 | type token = session 88 | type topic = string 89 | type message = string 90 | type channel = ChannelId of string | ChannelName of string 91 | type conversation = string 92 | type im = string 93 | type user = UserId of string | UserName of string 94 | type bot = BotId of string 95 | type group = GroupId of string | GroupName of string 96 | 97 | (* TODO: Sure about user? *) 98 | type chat = Channel of channel | Im of im | User of user | Group of group 99 | type sort_criterion = Score | Timestamp 100 | type sort_direction = Ascending | Descending 101 | type presence = Auto | Away 102 | 103 | let user_of_yojson = function 104 | | `String x -> Ok (UserId x) 105 | | _ -> Error "Couldn't parse user type" 106 | 107 | let bot_of_string s = 108 | if s.[0] = 'B' then BotId s else invalid_arg ("bot_of_string " ^ s) 109 | 110 | let bot_of_yojson = function 111 | | `String x -> Ok (bot_of_string x) 112 | | _ -> Error "Couldn't parse bot type" 113 | 114 | let channel_of_yojson = function 115 | | `String x -> Ok (ChannelId x) 116 | | _ -> Error "Couldn't parse channel type" 117 | 118 | let conversation_of_yojson = function 119 | | `String x -> Ok x 120 | | _ -> Error "Couldn't parse conversation type" 121 | 122 | let group_of_yojson = function 123 | | `String x -> Ok (GroupId x) 124 | | _ -> Error "Couldn't parse group type" 125 | 126 | let im_of_yojson = function 127 | | `String x -> Ok x 128 | | _ -> Error "Couldn't parse im type" 129 | 130 | type topic_obj = { value : string; creator : user; last_set : Timestamp.t } 131 | [@@deriving of_yojson] 132 | 133 | type channel_obj = { 134 | id : channel; 135 | name : string; 136 | is_channel : bool; 137 | created : Timestamp.t; 138 | creator : user; 139 | is_archived : bool; 140 | is_general : bool; 141 | name_normalized : string; 142 | is_member : bool; 143 | members : user list; 144 | topic : topic_obj; 145 | purpose : topic_obj; 146 | last_read : Timestamp.t option; [@default None] 147 | latest : Yojson.Safe.t option; [@default None] 148 | unread_count : int option; [@default None] 149 | unread_count_display : int option; [@default None] 150 | num_members : int option; [@default None] 151 | } 152 | [@@deriving of_yojson { strict = false }] 153 | 154 | type conversation_obj = { 155 | id : conversation; 156 | name : string; 157 | is_channel : bool; 158 | created : Timestamp.t; 159 | creator : user; 160 | is_archived : bool; 161 | is_general : bool; 162 | name_normalized : string; 163 | is_member : bool; 164 | topic : topic_obj; 165 | purpose : topic_obj; 166 | last_read : Timestamp.t option; [@default None] 167 | latest : string option; [@default None] 168 | unread_count : int option; [@default None] 169 | unread_count_display : int option; [@default None] 170 | num_members : int option; [@default None] 171 | } 172 | [@@deriving of_yojson { strict = false }] 173 | 174 | type user_obj = { 175 | id : user; 176 | name : string; 177 | deleted : bool; 178 | color : string option; [@default None] 179 | real_name : string option; [@default None] 180 | tz : string option; [@default None] 181 | tz_label : string option; [@default None] 182 | tz_offset : int; [@default 0] 183 | profile : Yojson.Safe.t; 184 | is_admin : bool; [@default false] 185 | is_owner : bool; [@default false] 186 | is_primary_owner : bool; [@default false] 187 | is_restricted : bool; [@default false] 188 | is_ultra_restricted : bool; [@default false] 189 | is_bot : bool; 190 | has_files : bool; [@default false] 191 | } 192 | [@@deriving of_yojson { strict = false }] 193 | 194 | type group_obj = { 195 | id : group; 196 | name : string; 197 | is_group : bool; 198 | created : Timestamp.t; 199 | creator : user; 200 | is_archived : bool; 201 | members : user list; 202 | topic : topic_obj; 203 | purpose : topic_obj; 204 | is_open : bool option; [@default None] 205 | last_read : Timestamp.t option; [@default None] 206 | unread_count : int option; [@default None] 207 | unread_count_display : int option; [@default None] 208 | latest : Yojson.Safe.t option; [@default None] 209 | } 210 | [@@deriving of_yojson { strict = false }] 211 | 212 | type file_obj = { 213 | (* TODO file id type *) 214 | id : string; 215 | created : Timestamp.t; 216 | (* deprecated *) 217 | timestamp : Timestamp.t; 218 | name : string option; [@default None] 219 | title : string; 220 | mimetype : string; 221 | pretty_type : string; 222 | user : user; 223 | mode : string; 224 | editable : bool; 225 | is_external : bool; 226 | external_type : string; 227 | size : int; 228 | url_private : string; 229 | url_private_download : string; 230 | thumb_64 : string option; [@default None] 231 | thunb_80 : string option; [@default None] 232 | thumb_360 : string option; [@default None] 233 | thumb_360_gif : string option; [@default None] 234 | thumb_360_w : int option; [@default None] 235 | thumb_360_h : int option; [@default None] 236 | permalink : string; 237 | edit_link : string option; [@default None] 238 | preview : string option; [@default None] 239 | preview_highlight : string option; [@default None] 240 | lines : int option; [@default None] 241 | lines_more : int option; [@default None] 242 | is_public : bool; 243 | (*public_url_shared: ???;*) 244 | channels : channel list; 245 | groups : group list; 246 | ims : im list; 247 | initial_comment : Yojson.Safe.t option; [@default None] 248 | num_stars : int option; [@default None] 249 | } 250 | [@@deriving of_yojson { strict = false }] 251 | 252 | type field_obj = { 253 | title : string option; [@default None] 254 | value : string; [@default ""] 255 | short : bool; [@default false] 256 | } 257 | [@@deriving to_yojson { strict = false }] 258 | 259 | let field ?title ?(short = false) value = { title; value; short } 260 | 261 | type attachment_obj = { 262 | fallback : string option; [@default None] 263 | color : string option; [@default None] 264 | pretext : string option; [@default None] 265 | author_name : string option; [@default None] 266 | author_link : string option; [@default None] 267 | author_icon : string option; [@default None] 268 | title : string option; [@default None] 269 | title_link : string option; [@default None] 270 | text : string option; [@default None] 271 | fields : field_obj list option; [@default None] 272 | image_url : string option; [@default None] 273 | thumb_url : string option; [@default None] 274 | footer : string option; [@default None] 275 | footer_icon : string option; [@default None] 276 | ts : Timestamp.t option; [@default None] 277 | mrkdwn_in : string list option; [@default None] 278 | } 279 | [@@deriving to_yojson { strict = false }] 280 | 281 | let if_none a b = match a with Some v -> Some v | None -> b 282 | 283 | let attachment ?fallback ?color ?pretext ?author_name ?author_link ?author_icon 284 | ?title ?title_link ?text ?fields ?image_url ?thumb_url ?footer ?footer_icon 285 | ?ts ?mrkdwn_in () = 286 | { 287 | fallback = if_none fallback text; 288 | color; 289 | pretext; 290 | author_name; 291 | author_link; 292 | author_icon; 293 | title; 294 | title_link; 295 | text; 296 | fields; 297 | image_url; 298 | thumb_url; 299 | footer; 300 | footer_icon; 301 | ts; 302 | mrkdwn_in; 303 | } 304 | 305 | type message_obj = { 306 | type' : string; [@key "type"] 307 | ts : Timestamp.t; 308 | user : user option; [@default None] 309 | bot_id : bot option; [@default None] 310 | text : string option; 311 | is_starred : bool option; [@default None] 312 | } 313 | [@@deriving of_yojson { strict = false }] 314 | 315 | type history_obj = { 316 | latest : Timestamp.t option; [@default None] 317 | messages : message_obj list; 318 | has_more : bool; 319 | } 320 | [@@deriving of_yojson { strict = false }] 321 | 322 | type authed_obj = { 323 | url : string; 324 | team : string; 325 | user : string; 326 | team_id : string; 327 | user_id : user; 328 | } 329 | [@@deriving of_yojson { strict = false }] 330 | 331 | type channel_leave_obj = { not_in_channel : bool option [@default None] } 332 | [@@deriving of_yojson { strict = false }] 333 | 334 | type channel_rename_obj = { 335 | id : channel; 336 | is_channel : bool; 337 | name : string; 338 | created : Timestamp.t; 339 | } 340 | [@@deriving of_yojson { strict = false }] 341 | 342 | let chat_of_yojson = function 343 | | `String c -> ( 344 | match c.[0] with 345 | | 'C' -> Ok (Channel (ChannelId c)) 346 | | 'D' -> Ok (Im c) 347 | | 'G' -> Ok (Group (GroupId c)) 348 | | _ -> Error "Failed to parse chat") 349 | | _ -> Error "Failed to parse chat" 350 | 351 | type chat_obj = { 352 | ts : Timestamp.t; 353 | chat : chat; [@key "channel"] 354 | text : string option; [@default None] 355 | } 356 | [@@deriving of_yojson { strict = false }] 357 | 358 | type emoji = string * string 359 | type emoji_list_obj = { emoji : (string * string) list } [@@deriving of_yojson] 360 | 361 | type chat_close_obj = { 362 | no_op : bool option; [@default None] 363 | already_closed : bool option; [@default None] 364 | } 365 | [@@deriving of_yojson { strict = false }] 366 | 367 | type groups_invite_obj = { 368 | already_in_group : bool option; [@default None] 369 | group : group_obj; 370 | } 371 | [@@deriving of_yojson { strict = false }] 372 | 373 | type groups_open_obj = { 374 | no_op : bool option; [@default None] 375 | already_open : bool option; [@default None] 376 | } 377 | [@@deriving of_yojson { strict = false }] 378 | 379 | type groups_rename_obj = { 380 | id : channel; 381 | is_group : bool; 382 | name : string; 383 | created : Timestamp.t; 384 | } 385 | [@@deriving of_yojson { strict = false }] 386 | 387 | type im_obj = { 388 | id : string; 389 | is_im : bool; 390 | user : user; 391 | created : Timestamp.t; 392 | is_user_deleted : bool; 393 | is_open : bool option; [@default None] 394 | last_read : Timestamp.t option; [@default None] 395 | unread_count : int option; [@default None] 396 | unread_count_display : int option; [@default None] 397 | } 398 | [@@deriving of_yojson { strict = false }] 399 | 400 | type im_channel_obj = { id : string } [@@deriving of_yojson { strict = false }] 401 | 402 | type im_open_obj = { 403 | no_op : bool option; [@default None] 404 | already_open : bool option; [@default None] 405 | channel : im_channel_obj; 406 | } 407 | [@@deriving of_yojson { strict = false }] 408 | 409 | type oauth_obj = { access_token : string; scope : string } 410 | [@@deriving of_yojson { strict = false }] 411 | 412 | type comment_obj = { 413 | id : string; 414 | timestamp : Timestamp.t; 415 | user : user; 416 | comment : string; 417 | } 418 | [@@deriving of_yojson { strict = false }] 419 | 420 | type paging_obj = { count : int; total : int; page : int; pages : int } 421 | [@@deriving of_yojson { strict = false }] 422 | 423 | type files_info_obj = { 424 | file : file_obj; 425 | comments : comment_obj list; 426 | paging : paging_obj; 427 | } 428 | [@@deriving of_yojson { strict = false }] 429 | 430 | type files_list_obj = { files : file_obj list; paging : paging_obj } 431 | [@@deriving of_yojson { strict = false }] 432 | 433 | type stars_list_obj = { 434 | (* TODO proper types *) 435 | items : Yojson.Safe.t list; 436 | paging : paging_obj; 437 | } 438 | [@@deriving of_yojson { strict = false }] 439 | 440 | type message_search_obj = { 441 | total : int; 442 | paging : paging_obj; 443 | matches : message_obj list; 444 | } 445 | [@@deriving of_yojson { strict = false }] 446 | 447 | type file_search_obj = { 448 | total : int; 449 | paging : paging_obj; 450 | matches : file_obj list; 451 | } 452 | [@@deriving of_yojson { strict = false }] 453 | 454 | type search_obj = { 455 | query : string; 456 | messages : message_search_obj option; [@default None] 457 | files : file_search_obj option; [@default None] 458 | } 459 | [@@deriving of_yojson { strict = false }] 460 | 461 | type team_obj = { 462 | (* TODO team id *) 463 | id : string; 464 | name : string; 465 | domain : string; 466 | email_domain : string; 467 | icon : Yojson.Safe.t; 468 | } 469 | [@@deriving of_yojson { strict = false }] 470 | 471 | type login_obj = { 472 | user_id : user; 473 | username : string; 474 | date_first : Timestamp.t; 475 | date_last : Timestamp.t; 476 | count : int; 477 | ip : string; 478 | user_agent : string; 479 | isp : string; 480 | country : string; 481 | region : string; 482 | } 483 | [@@deriving of_yojson { strict = false }] 484 | 485 | type team_access_log_obj = { logins : login_obj list; paging : paging_obj } 486 | [@@deriving of_yojson { strict = false }] 487 | 488 | type history_result = 489 | [ `Success of history_obj 490 | | parsed_auth_error 491 | | channel_error 492 | | timestamp_error ] 493 | 494 | (* internal *) 495 | let default_base_url = "https://slack.com/api/" 496 | 497 | type api_request = { method' : string; arguments : (string * string) list } 498 | 499 | let api_request method' = { method'; arguments = [] } 500 | 501 | let optionally_add key value request = 502 | match value with 503 | | None -> request 504 | | Some value -> { request with arguments = (key, value) :: request.arguments } 505 | 506 | let definitely_add key value = optionally_add key (Some value) 507 | 508 | (* private API return type *) 509 | (* the strict is important here, because we just match ok & error and 510 | * deliberately ignore the rest *) 511 | type api_answer = { ok : bool; error : string option [@default None] } 512 | [@@deriving of_yojson { strict = false }] 513 | 514 | let validate json = 515 | match api_answer_of_yojson json with 516 | | Error str -> `ParseFailure str 517 | | Ok parsed -> ( 518 | match (parsed.ok, parsed.error) with 519 | | true, _ -> `Json_response json 520 | | _, Some "account_inactive" -> `Account_inactive 521 | | _, Some "already_archived" -> `Already_archived 522 | | _, Some "already_in_channel" -> `Already_in_channel 523 | | _, Some "bad_client_secret" -> `Bad_client_secret 524 | | _, Some "bad_redirect_uri" -> `Bad_redirect_uri 525 | | _, Some "cant_archive_general" -> `Cant_archive_general 526 | | _, Some "cant_invite" -> `Cant_invite 527 | | _, Some "cant_invite_self" -> `Cant_invite_self 528 | | _, Some "cant_delete_file" -> `Cant_delete_file 529 | | _, Some "cant_delete_message" -> `Cant_delete_message 530 | | _, Some "cant_kick_from_general" -> `Cant_kick_from_general 531 | | _, Some "cant_kick_from_last_channel" -> `Cant_kick_from_last_channel 532 | | _, Some "cant_kick_self" -> `Cant_kick_self 533 | | _, Some "cant_leave_general" -> `Cant_leave_general 534 | | _, Some "cant_leave_last_channel" -> `Cant_leave_last_channel 535 | | _, Some "cant_update_message" -> `Cant_update_message 536 | | _, Some "channel_not_found" -> `Channel_not_found 537 | | _, Some "edit_window_closed" -> `Edit_window_closed 538 | | _, Some "file_deleted" -> `File_deleted 539 | | _, Some "file_not_found" -> `File_not_found 540 | | _, Some "invalid_auth" -> `Invalid_auth 541 | | _, Some "invalid_client_id" -> `Invalid_client_id 542 | | _, Some "invalid_code" -> `Invalid_code 543 | | _, Some "invalid_name" -> `Invalid_name 544 | | _, Some "invalid_presence" -> `Invalid_presence 545 | | _, Some "invalid_ts_latest" -> `Invalid_ts_latest 546 | | _, Some "invalid_ts_oldest" -> `Invalid_ts_oldest 547 | | _, Some "is_archived" -> `Is_archived 548 | | _, Some "last_member" -> `Last_member 549 | | _, Some "last_ra_channel" -> `Last_restricted_channel 550 | | _, Some "message_not_found" -> `Message_not_found 551 | (* not supposed to happen *) 552 | | _, Some "msg_too_long" -> `Msg_too_long 553 | | _, Some "too_many_attachments" -> `Too_many_attachments 554 | | _, Some "name_taken" -> `Name_taken 555 | (* can't really happen *) 556 | | _, Some "no_channel" -> `No_channel 557 | (* can't really happen either *) 558 | | _, Some "no_text" -> `No_text 559 | | _, Some "not_archived" -> `Not_archived 560 | | _, Some "not_authed" -> `Not_authed 561 | | _, Some "not_authorized" -> `Not_authorized 562 | | _, Some "not_in_channel" -> `Not_in_channel 563 | | _, Some "paid_only" -> `Paid_only 564 | | _, Some "rate_limited" -> `Rate_limited 565 | | _, Some "restricted_action" -> `Restricted_action 566 | | _, Some "too_long" -> `Too_long 567 | | _, Some "unknown_type" -> `Unknown_type 568 | | _, Some "user_does_not_own_channel" -> `User_does_not_own_channel 569 | | _, Some "user_is_bot" -> `User_is_bot 570 | | _, Some "user_is_restricted" -> `User_is_restricted 571 | (* lolwat, I'm not making this up *) 572 | | _, Some "user_is_ultra_restricted" -> `User_is_ultra_restricted 573 | | _, Some "user_not_found" -> `User_not_found 574 | | _, Some "user_not_visible" -> `User_not_visible 575 | (* when the API changes and introduces new, yet unhandled error types *) 576 | | _, Some err -> `Unhandled_error err 577 | | _ -> `Unknown_error) 578 | 579 | (* filter out "ok" and "error" keys *) 580 | let filter_useless = function 581 | | `Json_response (`Assoc items) -> 582 | `Json_response 583 | (`Assoc (List.filter (fun (k, _) -> k <> "ok" && k <> "error") items)) 584 | | otherwise -> otherwise 585 | 586 | let process request = 587 | request >|= snd >>= Cohttp_body.to_string >|= Yojson.Safe.from_string 588 | >|= validate >|= filter_useless 589 | 590 | let auth_header token = 591 | Cohttp.Header.init_with "Authorization" ("Bearer " ^ token) 592 | 593 | let endpoint base_url request = 594 | let url = Uri.of_string (base_url ^ request.method') in 595 | List.fold_left Uri.add_query_param' url request.arguments 596 | 597 | let unauthed_query ?(base_url = default_base_url) request = 598 | endpoint base_url request |> Cohttp_unix.Client.get |> process 599 | 600 | let query session request = 601 | endpoint session.base_url request 602 | |> Cohttp_unix.Client.get ~headers:(auth_header session.token) 603 | |> process 604 | 605 | (* do a POST request *) 606 | let query_post session body request = 607 | endpoint session.base_url request 608 | |> Cohttp_unix.Client.post ~headers:(auth_header session.token) ~body 609 | |> process 610 | 611 | let identity x = x 612 | let maybe fn = function Some v -> Some (fn v) | None -> None 613 | 614 | (* nonpublic types for conversion in list types *) 615 | type conversations_list_obj = { channels : conversation_obj list } 616 | [@@deriving of_yojson { strict = false }] 617 | 618 | type users_list_obj = { members : user_obj list } 619 | [@@deriving of_yojson { strict = false }] 620 | 621 | type groups_list_obj = { groups : group_obj list } [@@deriving of_yojson] 622 | type im_list_obj = { ims : im_obj list } [@@deriving of_yojson] 623 | 624 | let conversations_list ?exclude_archived session = 625 | api_request "conversations.list" 626 | |> optionally_add "exclude_archived" 627 | @@ maybe string_of_bool @@ exclude_archived 628 | |> query session 629 | >|= function 630 | | `Json_response d -> ( 631 | match d |> conversations_list_obj_of_yojson with 632 | | Ok x -> `Success x.channels 633 | | Error e -> `ParseFailure e) 634 | | #parsed_auth_error as res -> res 635 | | _ -> `Unknown_error 636 | 637 | let users_list session = 638 | api_request "users.list" |> query session >|= function 639 | | `Json_response d -> ( 640 | match d |> users_list_obj_of_yojson with 641 | | Ok x -> `Success x.members 642 | | Error x -> `ParseFailure x) 643 | | #parsed_auth_error as res -> res 644 | | _ -> `Unknown_error 645 | 646 | let groups_list ?exclude_archived session = 647 | api_request "groups.list" 648 | |> optionally_add "exclude_archived" @@ maybe string_of_bool exclude_archived 649 | |> query session 650 | >|= function 651 | | `Json_response d -> ( 652 | match d |> groups_list_obj_of_yojson with 653 | | Ok x -> `Success x.groups 654 | | Error x -> `ParseFailure x) 655 | | #parsed_auth_error as res -> res 656 | | _ -> `Unknown_error 657 | 658 | type 'a listfn = session -> [ `Success of 'a list | parsed_auth_error ] Lwt.t 659 | 660 | (* look up the id of query from results provided by the listfn *) 661 | let lookupk session (listfn : 'a listfn) filterfn k = 662 | let* v = listfn session in 663 | match v with 664 | | #parsed_auth_error as e -> Lwt.return e 665 | | `Success items -> Lwt.return @@ k @@ List.filter filterfn items 666 | 667 | let id_of_channel session = function 668 | | ChannelId id -> Lwt.return @@ `Found id 669 | | ChannelName name -> ( 670 | lookupk session conversations_list (fun (x : conversation_obj) -> 671 | x.name = name || x.name_normalized = name) 672 | @@ function 673 | | [] -> `Channel_not_found 674 | | [ { id = s; _ } ] -> `Found s 675 | | _ :: _ :: _ -> failwith "Too many results from channel id lookup.") 676 | 677 | (* like id_of_channel but does not resolve names to ids *) 678 | let string_of_channel = function ChannelId id -> id | ChannelName name -> name 679 | 680 | let id_of_user session = function 681 | | UserId id -> Lwt.return @@ `Found id 682 | | UserName name -> ( 683 | lookupk session users_list (fun (x : user_obj) -> x.name = name) 684 | @@ function 685 | | [] -> `User_not_found 686 | | [ { id = UserId s; _ } ] -> `Found s 687 | | [ _ ] -> failwith "Bad result from user id lookup." 688 | | _ :: _ :: _ -> failwith "Too many results from user id lookup.") 689 | 690 | let id_of_group session = function 691 | | GroupId id -> Lwt.return @@ `Found id 692 | | GroupName name -> ( 693 | lookupk session groups_list (fun (x : group_obj) -> x.name = name) 694 | @@ function 695 | | [] -> `Channel_not_found 696 | | [ { id = GroupId s; _ } ] -> `Found s 697 | | [ _ ] -> failwith "Bad result from group id lookup." 698 | | _ :: _ :: _ -> failwith "Too many results from group id lookup.") 699 | 700 | let id_of_chat session = function 701 | | Channel c -> id_of_channel session c 702 | | Im i -> Lwt.return @@ `Found i 703 | | User u -> id_of_user session u 704 | | Group g -> id_of_group session g 705 | 706 | let name_of_group = function 707 | | GroupId _ -> failwith "Need to specify a name" 708 | | GroupName name -> name 709 | 710 | let string_of_bool = function true -> "1" | false -> "0" 711 | let string_of_criterion = function Score -> "score" | Timestamp -> "timestamp" 712 | let string_of_direction = function Ascending -> "asc" | Descending -> "desc" 713 | let string_of_presence = function Auto -> "auto" | Away -> "away" 714 | 715 | (* Slacko API helper methods *) 716 | let start_session ?(base_url = default_base_url) token = { base_url; token } 717 | let token_of_string token = start_session token 718 | let message_of_string = identity 719 | 720 | (* Calculate the amount of codepoints in a string encoded in UTF-8 *) 721 | let utf8_codepoints text = 722 | (* convert string to int list *) 723 | let explode s = 724 | let rec exp i l = if i < 0 then l else exp (i - 1) (Char.code s.[i] :: l) in 725 | exp (String.length s - 1) [] 726 | in 727 | (* 728 | * http://www.daemonology.net/blog/2008-06-05-faster-utf8-strlen.html 729 | * http://porg.es/blog/counting-characters-in-utf-8-strings-is-faster 730 | *) 731 | let rec codepoints = function 732 | | [] -> 0 733 | | x :: xs when x < 0x7F -> 1 + codepoints xs 734 | | x :: _ :: xs when x >= 0xC0 && x <= 0xDF -> 1 + codepoints xs 735 | | x :: _ :: _ :: xs when x >= 0xE0 && x <= 0xEF -> 1 + codepoints xs 736 | | x :: _ :: _ :: _ :: xs when x >= 0xF0 && x <= 0xFF -> 1 + codepoints xs 737 | (* you are bad and should feel bad *) 738 | | x :: _ -> failwith @@ Printf.sprintf "Invalid UTF-8 byte: 0x%X" x 739 | in 740 | codepoints @@ explode text 741 | 742 | let topic_of_string text = 743 | if utf8_codepoints text <= 250 then Some text else None 744 | 745 | let topic_of_string_exn text = 746 | match topic_of_string text with Some t -> t | None -> failwith "Too long" 747 | 748 | let channel_of_string s = if s.[0] = 'C' then ChannelId s else ChannelName s 749 | let user_of_string s = if s.[0] = 'U' then UserId s else UserName s 750 | let group_of_string s = if s.[0] = 'G' then GroupId s else GroupName s 751 | 752 | (* TODO Create a im if im does not exist? *) 753 | let im_of_string s = if s.[0] = 'D' then s else failwith "Not an IM channel" 754 | 755 | let translate_parsing_error = function 756 | | Error a -> `ParseFailure a 757 | | Ok a -> `Success a 758 | 759 | (* Slack API begins here *) 760 | 761 | let api_test ?(base_url = default_base_url) ?foo ?error () = 762 | api_request "api.test" |> optionally_add "foo" foo 763 | |> optionally_add "error" error 764 | |> unauthed_query ~base_url 765 | >|= function 766 | | `Json_response x -> `Success x 767 | | #api_error as res -> res 768 | | _ -> `Unknown_error 769 | 770 | let auth_test session = 771 | api_request "auth.test" |> query session >|= function 772 | | `Json_response d -> d |> authed_obj_of_yojson |> translate_parsing_error 773 | | #parsed_auth_error as res -> res 774 | | _ -> `Unknown_error 775 | 776 | (* Operator for unwrapping channel_ids *) 777 | let ( |-> ) m f = 778 | let* m = m in 779 | match m with 780 | | (`Channel_not_found | #parsed_auth_error) as e -> Lwt.return e 781 | | `User_not_found -> Lwt.return `Unknown_error 782 | | `Found v -> f v 783 | 784 | (* Operator for unwrapping user_ids *) 785 | let ( |+> ) m f = 786 | let* m = m in 787 | match m with 788 | | `Channel_not_found -> Lwt.return `Unknown_error 789 | | (`User_not_found | #parsed_auth_error) as e -> Lwt.return e 790 | | `Found v -> f v 791 | 792 | let channels_archive session channel = 793 | id_of_channel session channel |-> fun channel_id -> 794 | api_request "channels.archive" 795 | |> definitely_add "channel" channel_id 796 | |> query session 797 | >|= function 798 | | `Json_response (`Assoc []) -> `Success 799 | | ( #parsed_auth_error 800 | | #channel_error 801 | | #bot_error 802 | | #already_archived_error 803 | | `Cant_archive_general | `Last_restricted_channel 804 | | #restriction_error 805 | | `User_is_restricted ) as res -> 806 | res 807 | | _ -> `Unknown_error 808 | 809 | let channels_create session name = 810 | api_request "channels.create" |> definitely_add "name" name |> query session 811 | >|= function 812 | | `Json_response (`Assoc [ ("channel", d) ]) -> 813 | d |> channel_obj_of_yojson |> translate_parsing_error 814 | | (#parsed_auth_error | #bot_error | #name_error | `User_is_restricted) as res 815 | -> 816 | res 817 | | _ -> `Unknown_error 818 | 819 | let channels_history session ?latest ?oldest ?count ?inclusive channel = 820 | id_of_channel session channel |-> fun channel_id -> 821 | api_request "channels.history" 822 | |> definitely_add "channel" channel_id 823 | |> optionally_add "latest" @@ maybe Timestamp.to_string latest 824 | |> optionally_add "oldest" @@ maybe Timestamp.to_string oldest 825 | |> optionally_add "count" @@ maybe string_of_int count 826 | |> optionally_add "inclusive" @@ maybe string_of_bool inclusive 827 | |> query session 828 | >|= function 829 | | `Json_response d -> d |> history_obj_of_yojson |> translate_parsing_error 830 | | #history_result as res -> res 831 | | _ -> `Unknown_error 832 | 833 | let channels_info session channel = 834 | id_of_channel session channel |-> fun channel_id -> 835 | api_request "channels.info" 836 | |> definitely_add "channel" channel_id 837 | |> query session 838 | >|= function 839 | | `Json_response (`Assoc [ ("channel", d) ]) -> 840 | d |> channel_obj_of_yojson |> translate_parsing_error 841 | | (#parsed_auth_error | #channel_error) as res -> res 842 | | _ -> `Unknown_error 843 | 844 | let channels_invite session channel user = 845 | id_of_channel session channel |-> fun channel_id -> 846 | id_of_user session user |+> fun user_id -> 847 | api_request "channels.invite" 848 | |> definitely_add "channel" channel_id 849 | |> definitely_add "user" user_id 850 | |> query session 851 | >|= function 852 | | `Json_response (`Assoc [ ("channel", d) ]) -> 853 | d |> channel_obj_of_yojson |> translate_parsing_error 854 | | ( #parsed_auth_error 855 | | #channel_error 856 | | #user_error 857 | | #bot_error 858 | | #invite_error 859 | | #not_in_channel_error 860 | | #already_in_channel_error 861 | | #archive_error 862 | | `User_is_ultra_restricted ) as res -> 863 | res 864 | | _ -> `Unknown_error 865 | 866 | let channels_join session name = 867 | api_request "channels.join" 868 | |> definitely_add "name" @@ string_of_channel name 869 | |> query session 870 | >|= function 871 | | `Json_response (`Assoc [ ("channel", d) ]) -> 872 | d |> channel_obj_of_yojson |> translate_parsing_error 873 | | ( #parsed_auth_error 874 | | #channel_error 875 | | #name_error 876 | | #archive_error 877 | | #bot_error 878 | | `User_is_restricted ) as res -> 879 | res 880 | | _ -> `Unknown_error 881 | 882 | let channels_kick session channel user = 883 | id_of_channel session channel |-> fun channel_id -> 884 | id_of_user session user |+> fun user_id -> 885 | api_request "channels.kick" 886 | |> definitely_add "channel" channel_id 887 | |> definitely_add "user" user_id 888 | |> query session 889 | >|= function 890 | | `Json_response (`Assoc []) -> `Success 891 | | ( #parsed_auth_error 892 | | #channel_error 893 | | #user_error 894 | | #bot_error 895 | | #channel_kick_error 896 | | #not_in_channel_error 897 | | #restriction_error 898 | | `User_is_restricted ) as res -> 899 | res 900 | | _ -> `Unknown_error 901 | 902 | let channels_leave session channel = 903 | id_of_channel session channel |-> fun channel_id -> 904 | api_request "channels.leave" 905 | |> definitely_add "channel" channel_id 906 | |> query session 907 | >|= function 908 | | `Json_response d -> 909 | d |> channel_leave_obj_of_yojson |> translate_parsing_error 910 | | ( #parsed_auth_error 911 | | #channel_error 912 | | #bot_error 913 | | #archive_error 914 | | #leave_general_error 915 | | `User_is_restricted ) as res -> 916 | res 917 | | _ -> `Unknown_error 918 | 919 | let channels_mark session channel ts = 920 | id_of_channel session channel |-> fun channel_id -> 921 | api_request "channels.mark" 922 | |> definitely_add "channel" channel_id 923 | |> definitely_add "ts" @@ Timestamp.to_string ts 924 | |> query session 925 | >|= function 926 | | `Json_response (`Assoc []) -> `Success 927 | | ( #parsed_auth_error 928 | | #channel_error 929 | | #archive_error 930 | | #not_in_channel_error ) as res -> 931 | res 932 | | _ -> `Unknown_error 933 | 934 | let channels_rename session channel name = 935 | id_of_channel session channel |-> fun channel_id -> 936 | api_request "channels.rename" 937 | |> definitely_add "channel" channel_id 938 | |> definitely_add "name" name |> query session 939 | >|= function 940 | | `Json_response (`Assoc [ ("channel", d) ]) -> 941 | d |> channel_rename_obj_of_yojson |> translate_parsing_error 942 | | ( #parsed_auth_error 943 | | #channel_error 944 | | #bot_error 945 | | #not_in_channel_error 946 | | #name_error 947 | | #invalid_name_error 948 | | `Not_authorized | `User_is_restricted ) as res -> 949 | res 950 | | _ -> `Unknown_error 951 | 952 | let channels_set_purpose session channel purpose = 953 | id_of_channel session channel |-> fun channel_id -> 954 | api_request "channels.setPurpose" 955 | |> definitely_add "channel" channel_id 956 | |> definitely_add "purpose" purpose 957 | |> query session 958 | >|= function 959 | | `Json_response (`Assoc [ ("purpose", `String d) ]) -> `Success d 960 | | #topic_result as res -> res 961 | | _ -> `Unknown_error 962 | 963 | let channels_set_topic session channel topic = 964 | id_of_channel session channel |-> fun channel_id -> 965 | api_request "channels.setTopic" 966 | |> definitely_add "channel" channel_id 967 | |> definitely_add "topic" topic 968 | |> query session 969 | >|= function 970 | | `Json_response (`Assoc [ ("topic", `String d) ]) -> `Success d 971 | | #topic_result as res -> res 972 | | _ -> `Unknown_error 973 | 974 | let channels_unarchive session channel = 975 | id_of_channel session channel |-> fun channel_id -> 976 | api_request "channels.unarchive" 977 | |> definitely_add "channel" channel_id 978 | |> query session 979 | >|= function 980 | | `Json_response (`Assoc []) -> `Success 981 | | ( #parsed_auth_error 982 | | #channel_error 983 | | #bot_error 984 | | `Not_archived | `User_is_restricted ) as res -> 985 | res 986 | | _ -> `Unknown_error 987 | 988 | let chat_delete session ts chat = 989 | id_of_chat session chat |-> fun chat_id -> 990 | api_request "chat.delete" 991 | |> definitely_add "channel" chat_id 992 | |> definitely_add "ts" @@ Timestamp.to_string ts 993 | |> query session 994 | >|= function 995 | | `Json_response d -> d |> chat_obj_of_yojson |> translate_parsing_error 996 | | (#parsed_auth_error | #channel_error | #message_error) as res -> res 997 | | _ -> `Unknown_error 998 | 999 | let jsonify_attachments attachments = 1000 | `List (List.map (fun a -> attachment_obj_to_yojson a) attachments) 1001 | |> Yojson.Safe.to_string 1002 | 1003 | let chat_post_message session chat ?as_user ?link_names ?mrkdwn ?reply_broadcast 1004 | ?thread_ts ?unfurl_links ?unfurl_media ?username ?parse ?icon_url 1005 | ?icon_emoji ?(attachments = []) text = 1006 | id_of_chat session chat |-> fun chat_id -> 1007 | api_request "chat.postMessage" 1008 | |> definitely_add "channel" chat_id 1009 | |> definitely_add "text" text 1010 | |> optionally_add "username" username 1011 | |> optionally_add "parse" parse 1012 | |> optionally_add "icon_url" icon_url 1013 | |> optionally_add "icon_emoji" icon_emoji 1014 | |> definitely_add "attachments" @@ jsonify_attachments attachments 1015 | |> optionally_add "as_user" @@ maybe string_of_bool as_user 1016 | |> optionally_add "link_names" @@ maybe string_of_bool link_names 1017 | |> optionally_add "mrkdwn" @@ maybe string_of_bool mrkdwn 1018 | |> optionally_add "reply_broadcast" @@ maybe string_of_bool reply_broadcast 1019 | |> optionally_add "thread_ts" @@ maybe Timestamp.to_string thread_ts 1020 | |> optionally_add "unfurl_links" @@ maybe string_of_bool unfurl_links 1021 | |> optionally_add "unfurl_media" @@ maybe string_of_bool unfurl_media 1022 | |> query session 1023 | >|= function 1024 | | `Json_response d -> d |> chat_obj_of_yojson |> translate_parsing_error 1025 | | ( #parsed_auth_error 1026 | | #channel_error 1027 | | #bot_error 1028 | | #archive_error 1029 | | #message_length_error 1030 | | #attachments_error 1031 | | #rate_error ) as res -> 1032 | res 1033 | | _ -> `Unknown_error 1034 | 1035 | let chat_update session ts chat ?as_user ?attachments ?link_names ?parse text = 1036 | id_of_chat session chat |-> fun chat_id -> 1037 | api_request "chat.update" 1038 | |> definitely_add "channel" chat_id 1039 | |> definitely_add "ts" @@ Timestamp.to_string ts 1040 | |> definitely_add "text" text 1041 | |> optionally_add "as_user" @@ maybe string_of_bool as_user 1042 | |> optionally_add "attachments" @@ maybe jsonify_attachments attachments 1043 | |> optionally_add "link_names" @@ maybe string_of_bool link_names 1044 | |> optionally_add "parse" parse 1045 | |> query session 1046 | >|= function 1047 | | `Json_response d -> d |> chat_obj_of_yojson |> translate_parsing_error 1048 | | ( #parsed_auth_error 1049 | | #channel_error 1050 | | #message_update_error 1051 | | #message_length_error 1052 | | #attachments_error ) as res -> 1053 | res 1054 | | _ -> `Unknown_error 1055 | 1056 | let emoji_list session = 1057 | api_request "emoji.list" |> query session >|= function 1058 | | `Json_response d -> ( 1059 | match d |> emoji_list_obj_of_yojson with 1060 | | Ok x -> `Success x.emoji 1061 | | Error x -> `ParseFailure x) 1062 | | #parsed_auth_error as res -> res 1063 | | _ -> `Unknown_error 1064 | 1065 | let files_delete session file = 1066 | api_request "files.delete" |> definitely_add "file" file |> query session 1067 | >|= function 1068 | | `Json_response (`Assoc []) -> `Success 1069 | | (#parsed_auth_error | #bot_error | `Cant_delete_file | #file_error) as res 1070 | -> 1071 | res 1072 | | _ -> `Unknown_error 1073 | 1074 | let files_info session ?count ?page file = 1075 | api_request "files.info" |> definitely_add "file" file 1076 | |> optionally_add "count" @@ maybe string_of_int count 1077 | |> optionally_add "page" @@ maybe string_of_int page 1078 | |> query session 1079 | >|= function 1080 | | `Json_response d -> d |> files_info_obj_of_yojson |> translate_parsing_error 1081 | | (#parsed_auth_error | #bot_error | #file_error) as res -> res 1082 | | _ -> `Unknown_error 1083 | 1084 | let maybe_with_user session user f = 1085 | match user with 1086 | | Some u -> ( 1087 | id_of_user session u >>= function 1088 | | `Found id -> f @@ Some id 1089 | | _ -> Lwt.return `User_not_found) 1090 | | None -> f None 1091 | 1092 | let files_list ?user ?ts_from ?ts_to ?types ?count ?page session = 1093 | maybe_with_user session user @@ fun user_id -> 1094 | api_request "files.list" 1095 | |> optionally_add "user" user_id 1096 | |> optionally_add "ts_from" @@ maybe Timestamp.to_string ts_from 1097 | |> optionally_add "ts_to" @@ maybe Timestamp.to_string ts_to 1098 | |> optionally_add "types" types 1099 | |> optionally_add "count" @@ maybe string_of_int count 1100 | |> optionally_add "page" @@ maybe string_of_int page 1101 | |> query session 1102 | >|= function 1103 | | `Json_response d -> d |> files_list_obj_of_yojson |> translate_parsing_error 1104 | | (#parsed_auth_error | #user_error | #bot_error | #unknown_type_error) as res 1105 | -> 1106 | res 1107 | | _ -> `Unknown_error 1108 | 1109 | let files_upload session ?filetype ?filename ?title ?initial_comment ?channels 1110 | content = 1111 | api_request "files.upload" 1112 | |> optionally_add "filetype" filetype 1113 | |> optionally_add "filename" filename 1114 | |> optionally_add "title" title 1115 | |> optionally_add "initial_comment" initial_comment 1116 | |> optionally_add "channels" channels 1117 | |> query_post session content 1118 | >|= function 1119 | | `Json_response (`Assoc [ ("file", d) ]) -> 1120 | d |> file_obj_of_yojson |> translate_parsing_error 1121 | | (#parsed_auth_error | #bot_error) as res -> res 1122 | | _ -> `Unknown_error 1123 | 1124 | let groups_archive session group = 1125 | id_of_group session group |-> fun group_id -> 1126 | api_request "groups.archive" 1127 | |> definitely_add "channel" group_id 1128 | |> query session 1129 | >|= function 1130 | | `Json_response (`Assoc []) -> `Success 1131 | | ( #parsed_auth_error 1132 | | #channel_error 1133 | | #bot_error 1134 | | #already_archived_error 1135 | | `Group_contains_others | `Last_restricted_channel 1136 | | #restriction_error 1137 | | `User_is_ultra_restricted ) as res -> 1138 | res 1139 | | _ -> `Unknown_error 1140 | 1141 | let groups_close session group = 1142 | id_of_group session group |-> fun group_id -> 1143 | api_request "groups.close" 1144 | |> definitely_add "channel" group_id 1145 | |> query session 1146 | >|= function 1147 | | `Json_response d -> d |> chat_close_obj_of_yojson |> translate_parsing_error 1148 | | (#parsed_auth_error | #channel_error) as res -> res 1149 | | _ -> `Unknown_error 1150 | 1151 | let groups_create session name = 1152 | api_request "groups.create" 1153 | |> definitely_add "name" @@ name_of_group name 1154 | |> query session 1155 | >|= function 1156 | | `Json_response (`Assoc [ ("group", d) ]) -> 1157 | d |> group_obj_of_yojson |> translate_parsing_error 1158 | | ( #parsed_auth_error 1159 | | #bot_error 1160 | | #name_error 1161 | | #restriction_error 1162 | | `User_is_ultra_restricted ) as res -> 1163 | res 1164 | | _ -> `Unknown_error 1165 | 1166 | let groups_create_child session group = 1167 | id_of_group session group |-> fun group_id -> 1168 | api_request "groups.createChild" 1169 | |> definitely_add "channel" group_id 1170 | |> query session 1171 | >|= function 1172 | | `Json_response (`Assoc [ ("group", d) ]) -> 1173 | d |> group_obj_of_yojson |> translate_parsing_error 1174 | | ( #parsed_auth_error 1175 | | #channel_error 1176 | | #bot_error 1177 | | #already_archived_error 1178 | | #restriction_error 1179 | | `User_is_ultra_restricted ) as res -> 1180 | res 1181 | | _ -> `Unknown_error 1182 | 1183 | let groups_history session ?latest ?oldest ?count ?inclusive group = 1184 | id_of_group session group |-> fun group_id -> 1185 | api_request "groups.history" 1186 | |> definitely_add "channel" group_id 1187 | |> optionally_add "latest" @@ maybe Timestamp.to_string latest 1188 | |> optionally_add "oldest" @@ maybe Timestamp.to_string oldest 1189 | |> optionally_add "count" @@ maybe string_of_int count 1190 | |> optionally_add "inclusive" @@ maybe string_of_bool inclusive 1191 | |> query session 1192 | >|= function 1193 | | `Json_response d -> d |> history_obj_of_yojson |> translate_parsing_error 1194 | | #history_result as res -> res 1195 | | _ -> `Unknown_error 1196 | 1197 | let groups_invite session group user = 1198 | id_of_group session group |-> fun group_id -> 1199 | id_of_user session user |+> fun user_id -> 1200 | api_request "groups.invite" 1201 | |> definitely_add "channel" group_id 1202 | |> definitely_add "user" user_id 1203 | |> query session 1204 | >|= function 1205 | | `Json_response d -> 1206 | d |> groups_invite_obj_of_yojson |> translate_parsing_error 1207 | | ( #parsed_auth_error 1208 | | #channel_error 1209 | | #user_error 1210 | | #bot_error 1211 | | #invite_error 1212 | | #archive_error 1213 | | `User_is_ultra_restricted ) as res -> 1214 | res 1215 | | _ -> `Unknown_error 1216 | 1217 | let groups_kick session group user = 1218 | id_of_group session group |-> fun group_id -> 1219 | id_of_user session user |+> fun user_id -> 1220 | api_request "groups.kick" 1221 | |> definitely_add "channel" group_id 1222 | |> definitely_add "user" user_id 1223 | |> query session 1224 | >|= function 1225 | | `Json_response (`Assoc []) -> `Success 1226 | | ( #parsed_auth_error 1227 | | #channel_error 1228 | | #user_error 1229 | | #bot_error 1230 | | #kick_error 1231 | | #not_in_group_error 1232 | | #restriction_error 1233 | | `User_is_restricted ) as res -> 1234 | res 1235 | | _ -> `Unknown_error 1236 | 1237 | let groups_leave session group = 1238 | id_of_group session group |-> fun group_id -> 1239 | api_request "groups.leave" 1240 | |> definitely_add "channel" group_id 1241 | |> query session 1242 | >|= function 1243 | | `Json_response (`Assoc []) -> `Success 1244 | | ( #parsed_auth_error 1245 | | #channel_error 1246 | | #bot_error 1247 | | #archive_error 1248 | | #leave_last_channel_error 1249 | | #last_member_error 1250 | | `User_is_ultra_restricted ) as res -> 1251 | res 1252 | | _ -> `Unknown_error 1253 | 1254 | let groups_mark session group ts = 1255 | id_of_group session group |-> fun group_id -> 1256 | api_request "groups.mark" 1257 | |> definitely_add "channel" group_id 1258 | |> definitely_add "ts" @@ Timestamp.to_string ts 1259 | |> query session 1260 | >|= function 1261 | | `Json_response (`Assoc []) -> `Success 1262 | | ( #parsed_auth_error 1263 | | #channel_error 1264 | | #archive_error 1265 | | #not_in_channel_error ) as res -> 1266 | res 1267 | | _ -> `Unknown_error 1268 | 1269 | let groups_open session group = 1270 | id_of_group session group |-> fun group_id -> 1271 | api_request "groups.open" 1272 | |> definitely_add "channel" group_id 1273 | |> query session 1274 | >|= function 1275 | | `Json_response d -> 1276 | d |> groups_open_obj_of_yojson |> translate_parsing_error 1277 | | (#parsed_auth_error | #channel_error) as res -> res 1278 | | _ -> `Unknown_error 1279 | 1280 | let groups_rename session group name = 1281 | id_of_group session group |-> fun group_id -> 1282 | api_request "groups.rename" 1283 | |> definitely_add "channel" group_id 1284 | |> definitely_add "name" name |> query session 1285 | >|= function 1286 | | `Json_response (`Assoc [ ("channel", d) ]) -> 1287 | d |> groups_rename_obj_of_yojson |> translate_parsing_error 1288 | | ( #parsed_auth_error 1289 | | #channel_error 1290 | | #bot_error 1291 | | #name_error 1292 | | #invalid_name_error 1293 | | `User_is_restricted ) as res -> 1294 | res 1295 | | _ -> `Unknown_error 1296 | 1297 | let groups_set_purpose session group purpose = 1298 | id_of_group session group |-> fun group_id -> 1299 | api_request "groups.setPurpose" 1300 | |> definitely_add "channel" group_id 1301 | |> definitely_add "purpose" purpose 1302 | |> query session 1303 | >|= function 1304 | | `Json_response (`Assoc [ ("purpose", `String d) ]) -> `Success d 1305 | | #topic_result as res -> res 1306 | | _ -> `Unknown_error 1307 | 1308 | let groups_set_topic session group topic = 1309 | id_of_group session group |-> fun group_id -> 1310 | api_request "groups.setTopic" 1311 | |> definitely_add "channel" group_id 1312 | |> definitely_add "topic" topic 1313 | |> query session 1314 | >|= function 1315 | | `Json_response (`Assoc [ ("topic", `String d) ]) -> `Success d 1316 | | #topic_result as res -> res 1317 | | _ -> `Unknown_error 1318 | 1319 | let groups_unarchive session group = 1320 | id_of_group session group |-> fun group_id -> 1321 | api_request "groups.unarchive" 1322 | |> definitely_add "channel" group_id 1323 | |> query session 1324 | >|= function 1325 | | `Json_response (`Assoc []) -> `Success 1326 | | ( #parsed_auth_error 1327 | | #channel_error 1328 | | #bot_error 1329 | | `Not_archived | `User_is_restricted ) as res -> 1330 | res 1331 | | _ -> `Unknown_error 1332 | 1333 | let im_close session channel = 1334 | api_request "im.close" |> definitely_add "channel" channel |> query session 1335 | >|= function 1336 | | `Json_response d -> d |> chat_close_obj_of_yojson |> translate_parsing_error 1337 | | (#parsed_auth_error | #channel_error | `User_does_not_own_channel) as res -> 1338 | res 1339 | | _ -> `Unknown_error 1340 | 1341 | let im_history session ?latest ?oldest ?count ?inclusive channel = 1342 | api_request "im.history" 1343 | |> definitely_add "channel" channel 1344 | |> optionally_add "latest" @@ maybe Timestamp.to_string latest 1345 | |> optionally_add "oldest" @@ maybe Timestamp.to_string oldest 1346 | |> optionally_add "count" @@ maybe string_of_int count 1347 | |> optionally_add "inclusive" @@ maybe string_of_bool inclusive 1348 | |> query session 1349 | >|= function 1350 | | `Json_response d -> d |> history_obj_of_yojson |> translate_parsing_error 1351 | | #history_result as res -> res 1352 | | _ -> `Unknown_error 1353 | 1354 | let im_list session = 1355 | api_request "im.list" |> query session >|= function 1356 | | `Json_response d -> ( 1357 | match d |> im_list_obj_of_yojson with 1358 | | Ok x -> `Success x.ims 1359 | | Error x -> `ParseFailure x) 1360 | | #parsed_auth_error as res -> res 1361 | | _ -> `Unknown_error 1362 | 1363 | let im_mark session channel ts = 1364 | api_request "im.mark" 1365 | |> definitely_add "channel" channel 1366 | |> definitely_add "ts" @@ Timestamp.to_string ts 1367 | |> query session 1368 | >|= function 1369 | | `Json_response (`Assoc []) -> `Success 1370 | | (#parsed_auth_error | #channel_error | #not_in_channel_error) as res -> res 1371 | | _ -> `Unknown_error 1372 | 1373 | let im_open session user = 1374 | id_of_user session user |+> fun user_id -> 1375 | api_request "im.open" |> definitely_add "user" user_id |> query session 1376 | >|= function 1377 | | `Json_response d -> d |> im_open_obj_of_yojson |> translate_parsing_error 1378 | | (#parsed_auth_error | #user_error | #user_visibility_error) as res -> res 1379 | | _ -> `Unknown_error 1380 | 1381 | let oauth_access ?(base_url = default_base_url) client_id client_secret 1382 | ?redirect_url code = 1383 | api_request "oauth.access" 1384 | |> definitely_add "client_id" client_id 1385 | |> definitely_add "client_secret" client_secret 1386 | |> definitely_add "code" code 1387 | |> optionally_add "redirect_url" redirect_url 1388 | |> unauthed_query ~base_url 1389 | >|= function 1390 | | `Json_response d -> d |> oauth_obj_of_yojson |> translate_parsing_error 1391 | | #oauth_error as res -> res 1392 | | _ -> `Unknown_error 1393 | 1394 | let search method' session ?sort ?sort_dir ?highlight ?count ?page query_ = 1395 | api_request method' 1396 | |> definitely_add "query" @@ query_ 1397 | |> optionally_add "sort" @@ maybe string_of_criterion sort 1398 | |> optionally_add "sort_dir" @@ maybe string_of_direction sort_dir 1399 | |> optionally_add "highlight" @@ maybe string_of_bool highlight 1400 | |> optionally_add "count" @@ maybe string_of_int count 1401 | |> optionally_add "page" @@ maybe string_of_int page 1402 | |> query session 1403 | >|= function 1404 | | `Json_response d -> d |> search_obj_of_yojson |> translate_parsing_error 1405 | | (#parsed_auth_error | #bot_error) as res -> res 1406 | | _ -> `Unknown_error 1407 | 1408 | let search_all = search "search.all" 1409 | let search_files = search "search.files" 1410 | let search_messages = search "search.messages" 1411 | 1412 | let stars_list ?user ?count ?page session = 1413 | maybe_with_user session user @@ fun user_id -> 1414 | api_request "stars.list" 1415 | |> optionally_add "user" user_id 1416 | |> optionally_add "count" @@ maybe string_of_int count 1417 | |> optionally_add "page" @@ maybe string_of_int page 1418 | |> query session 1419 | >|= function 1420 | | `Json_response d -> d |> stars_list_obj_of_yojson |> translate_parsing_error 1421 | | (#parsed_auth_error | #bot_error | #user_error) as res -> res 1422 | | _ -> `Unknown_error 1423 | 1424 | let team_access_logs ?count ?page session = 1425 | api_request "team.accessLogs" 1426 | |> optionally_add "count" @@ maybe string_of_int count 1427 | |> optionally_add "page" @@ maybe string_of_int page 1428 | |> query session 1429 | >|= function 1430 | | `Json_response d -> 1431 | d |> team_access_log_obj_of_yojson |> translate_parsing_error 1432 | | (#parsed_auth_error | `Paid_only | #bot_error) as res -> res 1433 | | _ -> `Unknown_error 1434 | 1435 | let team_info session = 1436 | api_request "team.info" |> query session >|= function 1437 | | `Json_response d -> d |> team_obj_of_yojson |> translate_parsing_error 1438 | | (#parsed_auth_error | #bot_error) as res -> res 1439 | | _ -> `Unknown_error 1440 | 1441 | let users_get_presence session user = 1442 | id_of_user session user |+> fun user_id -> 1443 | api_request "users.getPresence" 1444 | |> definitely_add "user" user_id 1445 | |> query session 1446 | >|= function 1447 | (* TODO parse more out of this *) 1448 | | `Json_response (`Assoc [ ("presence", `String d) ]) -> ( 1449 | match d with 1450 | | "active" -> `Success Auto 1451 | | "away" -> `Success Away 1452 | | _ -> `ParseFailure "Invalid presence") 1453 | | #parsed_auth_error as res -> res 1454 | | _ -> `Unknown_error 1455 | 1456 | let users_info session user = 1457 | id_of_user session user |+> fun user_id -> 1458 | api_request "users.info" |> definitely_add "user" user_id |> query session 1459 | >|= function 1460 | | `Json_response (`Assoc [ ("user", d) ]) -> 1461 | d |> user_obj_of_yojson |> translate_parsing_error 1462 | | (#parsed_auth_error | #user_error | #user_visibility_error) as res -> res 1463 | | _ -> `Unknown_error 1464 | 1465 | let users_set_active session = 1466 | api_request "users.setActive" |> query session >|= function 1467 | | `Json_response (`Assoc []) -> `Success 1468 | | (#bot_error | #parsed_auth_error) as res -> res 1469 | | _ -> `Unknown_error 1470 | 1471 | let users_set_presence session presence = 1472 | api_request "users.setPresence" 1473 | |> definitely_add "presence" @@ string_of_presence presence 1474 | |> query session 1475 | >|= function 1476 | | `Json_response (`Assoc []) -> `Success 1477 | | (#parsed_auth_error | #presence_error) as res -> res 1478 | | _ -> `Unknown_error 1479 | --------------------------------------------------------------------------------