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
|
module Tomato.Post
( postTomato
, uploadTomato
, postMessage
) where
import RIO
import Network.HTTP.Req
( jsonResponse
, ignoreResponse
, req
, ReqBodyFile (..)
, ReqBodyJson (..)
, (/:)
, POST (..)
, Req
, https
, header
, responseBody
)
import Data.Message (GMIUrl (..), OutMessage (..))
import qualified Data.Aeson as Ae
import qualified Data.Aeson.KeyMap as Ae
-- TODO global config reader monad
tomatoFile :: FilePath
tomatoFile = "tomato.png"
accessToken :: ByteString
accessToken = "t2YhlxxwZmn2cWfkAomjMc6BgVPMaC5NRkqHzGQl"
botId :: Text
botId = "713bcb4a4604006c944804552c"
-- | Post the current tomato
postTomato :: Req ()
postTomato = do
url <- uploadTomato
postMessage $ OutMessage url
-- | Upload the current tomato to the GroupMe image server
uploadTomato :: Req GMIUrl
uploadTomato = do
let url = https "image.groupme.com" /: "pictures"
js <- 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 -> error "deal with this later" -- TODO error monad
return gmURL
-- | Post a message to the group with image as attachment
postMessage :: OutMessage -> Req ()
postMessage outMes = do
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"
req POST url (ReqBodyJson outMes') ignoreResponse $
header "X-Access-Token" accessToken
return ()
|
