packages feed

bronyradiogermany-streaming (empty) → 1.0.0.0

raw patch · 5 files changed

+291/−0 lines, 5 filesdep +aesondep +basedep +bronyradiogermany-commonsetup-changed

Dependencies added: aeson, base, bronyradiogermany-common, bytestring, case-insensitive, http-types, mtl, streaming, streaming-bytestring, streaming-utils, text, time, uuid

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for bronyradiogermany-streaming++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Marvin Cohrs++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Marvin Cohrs nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bronyradiogermany-streaming.cabal view
@@ -0,0 +1,79 @@+-- Initial bronyradiogermany-streaming.cabal generated by cabal init.  For +-- further documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                bronyradiogermany-streaming++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- https://wiki.haskell.org/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             1.0.0.0++-- A short (one-line) description of the package.+synopsis:            Streaming interface for the BronyRadioGermany API.++-- A longer description of the package.+description:         This is a streaming interface for the API of BronyRadioGermany. Features: get the currently played song, the entire song history, the AutoDj track list, vote statistics, and the raw audio streams; it can also post up- and downvotes, as well as song requests. If you prefer conduit over streaming, please have a look at bronyradiogermany-conduit.++-- The license under which the package is released.+license:             BSD3++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Marvin Cohrs++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          darcs@m.doomanddarkness.eu++-- A copyright notice.+-- copyright:           ++category:            Network++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files:  ChangeLog.md++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10+++library+  -- Modules exported by the library.+  exposed-modules:     Network.Radio.BronyRadioGermany.Streaming+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:    +  +  -- Other library packages from which modules are imported.+  build-depends:       base >=4.9 && <4.10,+                       streaming,+                       streaming-bytestring,+                       streaming-utils,+                       bronyradiogermany-common,+                       uuid,+                       text,+                       aeson,+                       time,+                       mtl,+                       bytestring,+                       case-insensitive,+                       http-types+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+
+ src/Network/Radio/BronyRadioGermany/Streaming.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Radio.BronyRadioGermany.Streaming+       (-- * Simple information requests+        getStreamInfo,+        getTrackInfo,+        -- * Track streams+        getTrackList,+        getHistory,+        -- * Voting+        postUpVote,+        postUpVoteFresh,+        postDownVote,+        postDownVoteFresh,+        -- * AutoDJ requests+        postAutoDJRequest,+        postAutoDJTrackRequest,+        -- * Audio streams+        radioStream,+        -- * Errors+        AutoDjRequestError(..))+       where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans+import Data.Aeson hiding (encode)+import Data.Time.Clock+import qualified Data.Text as T+import Data.Text.Encoding+import Streaming+import qualified Streaming.Prelude as S+import qualified Data.ByteString.Streaming.Char8 as Q+import Data.ByteString.Streaming.HTTP+import Data.ByteString.Streaming.Aeson+import Network.Radio.BronyRadioGermany.Types as BRG+import Network.Radio.BronyRadioGermany.URI as BRG+import Network.HTTP.Types.URI+import Data.UUID+import Data.UUID.V4+import qualified Data.ByteString as BS+import qualified Data.CaseInsensitive as CI++request :: (FromJSON a, MonadIO m) => T.Text -> m (Maybe a)+request uri = handleResponse <$> request' uri+  where handleResponse (Just (Successful a _ _ _)) = Just a+        handleResponse _ = Nothing++request' :: (FromJSON a, MonadIO m) => T.Text -> m (Maybe (BRG.Response a))+request' uri = liftIO $ do+  m <- newManager tlsManagerSettings+  req <- parseRequest (T.unpack uri)+  withHTTP req m $ \resp ->+    S.head_ $+    decoded $+    responseBody resp++multipageRequest :: (FromJSON a, MonadIO m) => Int -> (Int -> T.Text) -> Stream (Of a) m ()+multipageRequest page uri = do+  mr <- liftIO $ request' $ uri page+  case mr of+    Nothing -> return ()+    Just (Successful rs (Just next) _ _) -> do+      S.each rs `const` head rs  -- head forces rs to be a list+      multipageRequest (page+1) uri+    Just (Successful rs Nothing _ _) -> S.each rs+    Just (Errorful msg) -> fail (T.unpack msg)++-- | Get information about the given channel+getStreamInfo :: MonadIO m => Mountpoint -> m (Maybe StreamInfo)+getStreamInfo = request . brgStreamInfoURI++-- | Get information about the given track+getTrackInfo :: (HasTrackId t, MonadIO m) => t -> m (Maybe TrackInfo)+getTrackInfo = request . brgTrackInfoURI++-- | Get the AutoDJ's track list+getTrackList :: MonadIO m => Maybe T.Text -- ^ Title mask (use % as a wildcard)+                -> Maybe T.Text           -- ^ Artist mask (use % as a wildcard)+                -> Stream (Of Track) m ()+getTrackList mtitle martist = do+  mlist <- request $ brgTrackListURI mtitle martist+  case mlist of+    Just list -> S.each list `const` head list -- head forces list to be a list+    Nothing -> return ()++-- | Get the song history of the main channel+getHistory :: MonadIO m => Maybe UTCTime  -- ^ start time+              -> Maybe UTCTime            -- ^ end time+              -> Maybe T.Text             -- ^ title mask (use % as a wildcard)+              -> Maybe T.Text             -- ^ artist mask+              -> Stream (Of HistoryItem) m ()+getHistory mstart mend mtitle martist = do+  end' <- case mend of+    Just end -> return end+    Nothing -> liftIO getCurrentTime+  multipageRequest 1 $ \i -> brgHistoryURI i mstart (Just end') mtitle martist++-- | Check Vote status for a given UUID and mountpoint+getVoteStatus :: MonadIO m => UUID -> Mountpoint -> m (Maybe VoteCheckResult)+getVoteStatus uuid mp = request $ brgVoteCheckURI uuid mp++-- | Post an upvote using the given UUID (caution: even though this is logically a post, the HTTP method is GET)+postUpVote :: MonadIO m => UUID -> Mountpoint -> m (Maybe VoteResult)+postUpVote uuid mp = request $ brgUpVoteURI uuid mp++-- | Post a downvote using the given UUID (caution: even though this is logically a post, the HTTP method is GET)+postDownVote :: MonadIO m => UUID -> Mountpoint -> m (Maybe VoteResult)+postDownVote uuid mp = request $ brgDownVoteURI uuid mp++-- | Post an upvote using a fresh UUID+postUpVoteFresh :: MonadIO m => Mountpoint -> m (Maybe VoteResult)+postUpVoteFresh mp = do+  uuid <- liftIO nextRandom+  postUpVote uuid mp++-- | Post a downvote using a fresh UUID+postDownVoteFresh :: MonadIO m => Mountpoint -> m (Maybe VoteResult)+postDownVoteFresh mp = do+  uuid <- liftIO nextRandom+  postDownVote uuid mp++-- | Thrown if the AutoDJ song request has been rejected, i.e. due to quota violation+data AutoDjRequestError = AutoDjRequestRejected deriving (Eq,Show,Read)++instance Exception AutoDjRequestError++-- | Request a song from the AutoDJ. Throws AutoDjRequestRejected if the request is rejected by the server, i.e. the quota is violated+postAutoDJRequest :: (MonadIO m,MonadThrow m) => T.Text -- ^ your nickname+                     -> T.Text           -- ^ track title+                     -> T.Text           -- ^ track artist+                     -> m ()+postAutoDJRequest nick title artist = do+  let body = renderQuery False+             [("title", Just (encodeUtf8 title)),+              ("artist", Just (encodeUtf8 artist)),+              ("nickname", Just (encodeUtf8 nick))]+  req <- parseRequest $ T.unpack brgAutoDJRequestURI+  m <- liftIO $ newManager tlsManagerSettings+  uuid <- liftIO nextRandom+  let req' = req{+        method = "POST",+        requestBody = RequestBodyBS body}+      req'' = addRequestHeader "cookie" ("brg-player-voting-uuid="<>toASCIIBytes uuid) $+              addRequestHeader "content-type" "application/x-www-form-urlencoded; charset=UTF-8" $+              addRequestHeader "referer" "https://www.bronyradiogermany.com/request-v2/include/request.php" $+              addRequestHeader "origin" "https://www.bronyradiogermany.com" $+              addRequestHeader "x-requested-with" "XMLHttpRequest" req'+  resp <- liftIO $ withHTTP req'' m $ \resp -> Q.toStrict_ $ responseBody resp+  if resp == "Request wurde eingereicht."+    then return ()+    else throwM AutoDjRequestRejected++-- | Request a song from the AutoDJ+postAutoDJTrackRequest :: (MonadIO m, MonadThrow m, HasTrack t)+                          => T.Text -- ^ your nickname+                          -> t      -- ^ requested track+                          -> m ()+postAutoDJTrackRequest nick track =+  postAutoDJRequest nick (trackTitle track) (trackArtist track)++-- | Raw radio stream. Use an audio library to extract frames, or pipe it into an audio device+radioStream :: MonadResource m => Mountpoint -> Q.ByteString m ()+radioStream mp = do+  req <- parseRequest $ T.unpack $ brgStreamURI mp+  m <- liftIO $ newManager tlsManagerSettings +  resp <- lift $ http req m+  responseBody resp++addRequestHeader :: BS.ByteString -> BS.ByteString -> Request -> Request+addRequestHeader key val req =+  let key' = CI.mk key+      h = (key', val)+  in req{requestHeaders= h : requestHeaders req}