{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.TwitchAPI.Helix.Users where import Prelude import Data.Functor ( (<&>) ) import qualified Data.ByteString.Char8 as BS import qualified Data.Time as Time import qualified Data.Time.RFC3339 as Time ( parseTimeRFC3339 ) import qualified Network.HTTP.Client as HTTP import Data.Aeson ( FromJSON(..), (.:), withObject ) import Data.Aeson.KeyMap ( toAscList ) import qualified Web.TwitchAPI.Helix.Request as Req -- BUG: Not yet implemented: -- - Update User -- - Block/Unblock User -- - Update User Extensions data User = User { lookupID :: Maybe String , username :: Maybe String } deriving ( Show ) instance Req.HelixRequest User where toRequest user = let lookupID' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\i -> [("id", Just . BS.pack . show $ i)]) (lookupID user) username' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\u -> [("login", Just . BS.pack $ u)]) (username user) setQuery = HTTP.setQueryString $ lookupID' ++ username' in setQuery $ HTTP.parseRequest_ "GET https://api.twitch.tv/helix/users" scope User{} = Just "user:read:email" data BroadcasterType = Partner | Affiliate | None deriving ( Eq, Show ) instance Read BroadcasterType where readsPrec _ "partner" = [(Partner, "")] readsPrec _ "affiliate" = [(Affiliate, "")] readsPrec _ _ = [(None, "")] data UserType = Staff | Admin | GlobalMod | NormalUser deriving ( Eq, Show ) instance Read UserType where readsPrec _ "staff" = [(Staff, "")] readsPrec _ "admin" = [(Admin, "")] readsPrec _ "global_mod" = [(GlobalMod, "")] readsPrec _ _ = [(NormalUser, "")] data UserEntry = UserEntry { broadcasterType :: BroadcasterType , description :: String , displayName :: String , userId :: Integer , login :: String , offlineImageURL :: String , profileImageURL :: String , userType :: UserType , email :: Maybe String , createdAt :: Maybe Time.UTCTime } deriving ( Show, Eq ) instance FromJSON UserEntry where parseJSON = withObject "UserEntry" $ \o -> do userId' :: String <- o .: "id" created :: String <- o .: "created_at" userType' :: String <- o .: "type" broadcasterType' :: String <- o .: "broadcaster_type" let userId = read userId' :: Integer createdAt = Time.zonedTimeToUTC <$> Time.parseTimeRFC3339 created userType = read userType' :: UserType broadcasterType = read broadcasterType' :: BroadcasterType description <- o .: "description" displayName <- o .: "display_name" login <- o .: "login" offlineImageURL <- o .: "offline_image_url" profileImageURL <- o .: "profile_image_url" email <- o .: "email" return UserEntry{..} data Users = Users { lookupIDs :: [Integer] , usernames :: [String] } deriving ( Show, Eq ) instance Req.HelixRequest Users where toRequest users = let lookupID' :: [(BS.ByteString, Maybe BS.ByteString)] = (\i -> ("id", Just . BS.pack . show $ i)) <$> lookupIDs users username' :: [(BS.ByteString, Maybe BS.ByteString)] = (\u -> ("login", Just . BS.pack $ u)) <$> usernames users setQuery = HTTP.setQueryString $ lookupID' ++ username' in setQuery $ HTTP.parseRequest_ "GET https://api.twitch.tv/helix/users" scope Users{} = Nothing newtype UsersResponse = UsersResponse { users :: [UserEntry] } deriving ( Eq, Show ) instance FromJSON UsersResponse where parseJSON = withObject "UsersResponse" $ \o -> do users <- o .: "data" return UsersResponse{..} data Follows = Follows { after :: Maybe String , max :: Maybe Integer , from :: Maybe Integer , to :: Maybe Integer } deriving ( Show, Eq ) instance Req.HelixRequest Follows where toRequest user = let after' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\a -> [("after", Just . BS.pack $ a)]) (after user) max' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\u -> [("first", Just . BS.pack . show $ u)]) (from user) fromID' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\u -> [("after", Just . BS.pack . show $ u)]) (from user) toID' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\u -> [("after", Just . BS.pack . show $ u)]) (to user) setQuery = HTTP.setQueryString $ concat [after', max', fromID', toID'] in setQuery $ HTTP.parseRequest_ "GET https://api.twitch.tv/helix/users/follows" scope Follows{} = Nothing data FollowEntry = FollowEntry { fromID :: Integer , fromLogin :: String , fromName :: String , toID :: Integer , toName :: String , followedAt :: Maybe Time.UTCTime } deriving ( Show, Eq ) instance FromJSON FollowEntry where parseJSON = withObject "FollowEntry" $ \o -> do fromID' :: String <- o .: "from_id" toID' :: String <- o .: "to_id" followedAt' :: String <- o .: "followed_at" let fromID = read fromID' :: Integer toID = read toID' :: Integer followedAt = Time.zonedTimeToUTC <$> Time.parseTimeRFC3339 followedAt' fromLogin <- o .: "from_login" fromName <- o .: "from_name" toName <- o .: "to_name" return FollowEntry{..} data FollowsResponse = FollowsResponse { total :: Integer , users :: [FollowEntry] , paginationCursor :: String } deriving ( Show, Eq ) instance FromJSON FollowsResponse where parseJSON = withObject "FollowsResponse" $ \o -> do total <- o .: "total" paginationCursor <- (o .: "pagination") >>= (.: "cursor") users <- o .: "data" return FollowsResponse{..} newtype BlockList = BlockList { broadcasterID :: Integer } deriving ( Show, Eq ) instance Req.HelixRequest BlockList where toRequest user = HTTP.setQueryString [("login", Just . BS.pack . show . broadcasterID $ user)] $ HTTP.parseRequest_ "https://api.twitch.tv/helix/users/blocks" scope BlockList{} = Just "user:read:blocked_users" data BlockListEntry = BlockListEntry { userId :: Integer , userLogin :: String , displayName :: String } deriving ( Show, Eq ) instance FromJSON BlockListEntry where parseJSON = withObject "BlockListEntry" $ \o -> do userId' :: String <- o .: "user_id" let userId = read userId' :: Integer userLogin <- o .: "user_login" displayName <- o .: "display_name" return BlockListEntry{..} newtype BlockListResponse = BlockListResponse { blocks :: [BlockListEntry] } deriving ( Show, Eq ) instance FromJSON BlockListResponse where parseJSON = withObject "BlockListResponse" $ \o -> do blocks <- o .: "data" return BlockListResponse{..} data Extensions = Extensions instance Req.HelixRequest Extensions where toRequest _ = HTTP.parseRequest_ "GET https://api.twitch.tv/helix/users/extensions/list" scope Extensions = Just "user:read:broadcast" data ExtensionType = Component | Mobile | Panel | Overlay deriving ( Show, Eq ) instance Read ExtensionType where readsPrec _ "component" = [(Component, "")] readsPrec _ "mobile" = [(Mobile, "")] readsPrec _ "panel" = [(Panel, "")] readsPrec _ "overlay" = [(Overlay, "")] readsPrec _ _ = mempty data ExtensionsEntry = ExtensionsEntry { canActivate :: Bool , extensionId :: String , name :: String , extensionTypes :: [ExtensionType] , version :: String } deriving ( Show, Eq ) instance FromJSON ExtensionsEntry where parseJSON = withObject "ExtensionsEntry" $ \o -> do extensionTypes' :: [String] <- o .: "type" let extensionTypes :: [ExtensionType] = read <$> extensionTypes' canActivate <- o .: "can_activate" extensionId <- o .: "id" name <- o .: "name" version <- o .: "version" return ExtensionsEntry{..} newtype ExtensionsResponse = ExtensionsResponse { extensions :: [ExtensionsEntry] } deriving ( Show, Eq ) instance FromJSON ExtensionsResponse where parseJSON = withObject "ExtensionsResponse" $ \o -> do extensions <- o .: "data" return ExtensionsResponse{..} newtype ActiveExtensions = ActiveExtensions { userID :: Maybe Integer } deriving ( Show, Eq ) instance Req.HelixRequest ActiveExtensions where toRequest user = let userID' :: [(BS.ByteString, Maybe BS.ByteString)] = maybe [] (\i -> [("user_id", Just . BS.pack . show $ i)]) (userID user) setQuery = HTTP.setQueryString userID' in setQuery $ HTTP.parseRequest_ "GET https://api.twitch.tv/helix/users/extensions" scope ActiveExtensions{} = Nothing data ActiveComponentExtensionEntry' = ActiveComponentExtensionEntry' { active :: Bool , extensionId :: String , version :: String , name :: String , x :: Integer , y :: Integer } | InactiveComponentExtension deriving ( Show, Eq ) instance FromJSON ActiveComponentExtensionEntry' where parseJSON = withObject "ActiveExtensionEntry" $ \o -> do active <- o .: "active" if active then do extensionId <- o .: "id" version <- o .: "version" name <- o .: "name" x <- o .: "x" y <- o .: "y" return ActiveComponentExtensionEntry'{..} else return InactiveComponentExtension data ActiveComponentExtensionEntry = ActiveComponentExtensionEntry { active :: Bool , extensionId :: String , version :: String , name :: String , x :: Integer , y :: Integer } deriving ( Show, Eq ) filterActiveComponentExtensions :: [ActiveComponentExtensionEntry'] -> [ActiveComponentExtensionEntry] filterActiveComponentExtensions = reverse . foldl filterActiveComponentExtensions' [] filterActiveComponentExtensions' :: [ActiveComponentExtensionEntry] -> ActiveComponentExtensionEntry' -> [ActiveComponentExtensionEntry] filterActiveComponentExtensions' as InactiveComponentExtension = as filterActiveComponentExtensions' as (ActiveComponentExtensionEntry' _ i v n x y) = ActiveComponentExtensionEntry True i v n x y : as data ActiveExtensionEntry' = ActiveExtensionEntry' { active :: Bool , extensionId :: String , version :: String , name :: String } | InactiveExtension deriving ( Show, Eq ) instance FromJSON ActiveExtensionEntry' where parseJSON = withObject "ActiveExtensionEntry" $ \o -> do active <- o .: "active" if active then do extensionId <- o .: "id" version <- o .: "version" name <- o .: "name" return ActiveExtensionEntry'{..} else return InactiveExtension data ActiveExtensionEntry = ActiveExtensionEntry { active :: Bool , extensionId :: String , version :: String , name :: String } deriving ( Show, Eq ) filterActiveExtensions :: [ActiveExtensionEntry'] -> [ActiveExtensionEntry] filterActiveExtensions = reverse . foldl filterActiveExtensions' [] filterActiveExtensions' :: [ActiveExtensionEntry] -> ActiveExtensionEntry' -> [ActiveExtensionEntry] filterActiveExtensions' as InactiveExtension = as filterActiveExtensions' as (ActiveExtensionEntry' _ i v n) = ActiveExtensionEntry True i v n : as data ActiveExtensionsResponse = ActiveExtensionsResponse { components :: [ActiveComponentExtensionEntry] , overlays :: [ActiveExtensionEntry] , panels :: [ActiveExtensionEntry] } deriving ( Show, Eq ) instance FromJSON ActiveExtensionsResponse where parseJSON = withObject "ActiveExtensionsResponse" $ \o -> do components <- (((o .: "data") >>= (.: "component")) <&> ((snd <$>) . toAscList)) <&> filterActiveComponentExtensions overlays <- (((o .: "data") >>= (.: "overlay")) <&> ((snd <$>) . toAscList)) <&> filterActiveExtensions panels <- (((o .: "data") >>= (.: "panel")) <&> ((snd <$>) . toAscList)) <&> filterActiveExtensions return ActiveExtensionsResponse{..}