1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
module Tomato.Post
( postTomato
, uploadTomato
, postMessage
) where
import RIO
import Network.HTTP.Req
( jsonResponse
, ignoreResponse
, req
, Req
, defaultHttpConfig
, runReq
, ReqBodyFile (..)
, ReqBodyJson (..)
, (/:)
, POST (..)
, Req
, https
, header
, responseBody
)
import Tomato.Data.Except (DecodeException (..))
import Tomato.Data.Message (GMIUrl (..), OutMessage (..))
import Tomato.App (App (..))
import qualified Data.Aeson as Ae
import qualified Data.Aeson.KeyMap as Ae
import qualified RIO.Text as T
-- | Post the current tomato
postTomato :: RIO App ()
postTomato = do
url <- uploadTomato
postMessage $ OutMessage url
-- | Upload the current tomato to the GroupMe image server
uploadTomato :: RIO App GMIUrl
uploadTomato = do
tomatoFile <- asks appFile
accessToken <- asks appToken
let url = https "image.groupme.com" /: "pictures"
js <- rr $ req POST url (ReqBodyFile tomatoFile) jsonResponse $
header "X-Access-Token" accessToken <>
header "Content-Type" "image/png"
gmURL <- case Ae.fromJSON (responseBody js) of
Ae.Success r -> pure r
Ae.Error s -> throwM $ DecodeException $ T.pack s
return gmURL
-- | Post a message to the group with image as attachment
postMessage :: OutMessage -> RIO App ()
postMessage outMes = do
botId <- asks appBotId
accessToken <- asks appToken
let url = https "api.groupme.com" /: "v3" /: "bots" /: "post"
outMes' = case Ae.toJSON outMes of
Ae.Object o -> Ae.Object $ Ae.insert "bot_id" (Ae.toJSON botId) o
_ -> error "exceptional"
rr $ req POST url (ReqBodyJson outMes') ignoreResponse $
header "X-Access-Token" accessToken
return ()
rr :: Req a -> RIO App a
rr = runReq defaultHttpConfig
|
