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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
{-# Language RecordWildCards #-}
{-# Language ApplicativeDo #-}
module Fig.Monitor.Twitch.Utils
( FigMonitorTwitchException(..)
, loadConfig
, RequestConfig(..)
, Config(..)
, authedRequest
, authedRequestJSON
, Authed
, runAuthed
, userIsLiveScrape
) where
import Fig.Prelude
import Control.Monad.Reader (ReaderT, runReaderT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Toml
import qualified Data.Aeson as Aeson
import Network.HTTP.Client as HTTP
import Network.HTTP.Client.TLS as HTTP
newtype FigMonitorTwitchException = FigMonitorTwitchException Text
deriving (Show, Eq, Ord)
instance Exception FigMonitorTwitchException
data Config = Config
{ clientId :: Text
, userToken :: Text
, userLogin :: Text
, monitor :: [Text]
} deriving (Show, Eq, Ord)
configCodec :: Toml.TomlCodec Config
configCodec = do
clientId <- Toml.text "client_id" Toml..= (\a -> a.clientId)
userToken <- Toml.text "user_token" Toml..= (\a -> a.userToken)
-- userIds <- Toml.arrayOf Toml._Text "user_ids" Toml..= (\a -> a.userIds)
userLogin <- Toml.text "user_login" Toml..= (\a -> a.userLogin)
monitor <- Toml.arrayOf Toml._Text "monitor" Toml..= (\a -> a.monitor)
pure $ Config{..}
loadConfig :: FilePath -> IO Config
loadConfig path = Toml.decodeFileEither configCodec path >>= \case
Left err -> throwM . FigMonitorTwitchException $ tshow err
Right config -> pure config
data RequestConfig = RequestConfig
{ config :: Config
, manager :: HTTP.Manager
}
newtype Authed a = Authed { unAuthed :: ReaderT RequestConfig IO a }
deriving (Functor, Applicative, Monad, MonadReader RequestConfig, MonadIO, MonadThrow)
authedRequest :: Text -> Text -> BS.Lazy.ByteString -> Authed BS.Lazy.ByteString
authedRequest method url body = do
rc <- ask
initialRequest <- liftIO . HTTP.parseRequest $ unpack url
let request = initialRequest
{ method = encodeUtf8 method
, requestBody = RequestBodyLBS body
, requestHeaders =
[ ("Authorization", encodeUtf8 $ "Bearer " <> rc.config.userToken)
, ("Client-Id", encodeUtf8 rc.config.clientId)
, ("Content-Type", "application/json")
]
}
response <- liftIO $ HTTP.httpLbs request rc.manager
pure $ HTTP.responseBody response
authedRequestJSON :: (Aeson.ToJSON a, Aeson.FromJSON b) => Text -> Text -> Maybe a -> Authed b
authedRequestJSON method url val = do
resp <- authedRequest method url $ maybe "" Aeson.encode val
case Aeson.eitherDecode resp of
Left err -> do
throwM . FigMonitorTwitchException $ tshow err
Right res -> pure res
runAuthed :: Config -> Authed a -> IO a
runAuthed config body = do
manager <- HTTP.newManager HTTP.tlsManagerSettings
runReaderT body.unAuthed RequestConfig{..}
userIsLiveScrape :: Text -> Authed Bool
userIsLiveScrape user = do
rc <- ask
request <- liftIO . HTTP.parseRequest $ mconcat
[ "https://twitch.tv/"
, unpack user
]
response <- liftIO $ HTTP.httpLbs request rc.manager
let res = BS.isInfixOf "\"isLiveBroadcast\":true" . BS.Lazy.toStrict $ HTTP.responseBody response
log $ mconcat
[ user
, " is "
, if res then "" else "not "
, "live"
]
pure res
|
