playlists-http (empty) → 0.1.0.0

raw patch · 9 files changed

+435/−0 lines, 9 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, either, exceptions, http-client, mtl, playlists, playlists-http, text

Files

AUTHORS +1/−0
CHANGES.md +3/−0
LICENSE +30/−0
README.md +16/−0
Setup.hs +2/−0
examples/example.hs +46/−0
playlists-http.cabal +77/−0
src/Text/Playlist/HTTP/Full.hs +209/−0
src/Text/Playlist/HTTP/Simple.hs +51/−0

+ AUTHORS view

@@ -0,0 +1,1 @@+Peter Jones <pjones@devalot.com> (Maintainer)

+ CHANGES.md view

@@ -0,0 +1,3 @@+# Version 0.1.0.0 (November 21, 2016)++  * Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2016 Peter Jones <pjones@devalot.com>++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 Peter Jones 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.

+ README.md view

@@ -0,0 +1,16 @@+# playlists-http++Download and parse playlists over HTTP.++## Usage++There are two interfaces, a simple `download` function that runs in+`IO` and a more complicated `download` function that uses `MonadIO`.++See the following modules for more details:++  * `Text.Playlist.HTTP.Simple`+  * `Text.Playlist.HTTP.Full`++There is also an `examples/example.hs` that demonstrates how to use+the `download` function which is found in `Text.Playlist.HTTP.Full`.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ examples/example.hs view

@@ -0,0 +1,46 @@+{-++This file is part of the Haskell package playlists-http. It is subject to+the license terms in the LICENSE file found in the top-level directory+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part+of playlists-http package, including this file, may be copied, modified,+propagated, or distributed except according to the terms contained in+the LICENSE file.++-}++--------------------------------------------------------------------------------+module Main (main) where++--------------------------------------------------------------------------------+import Text.Playlist.HTTP.Full++--------------------------------------------------------------------------------+import Control.Monad (when)+import qualified Data.Text as Text+import Network.HTTP.Client (newManager, defaultManagerSettings, Manager)+import System.Environment (getArgs)++--------------------------------------------------------------------------------+-- | Main!+main :: IO ()+main = do+    args <- getArgs+    when (null args) $ fail "Usage: example URL"++    -- For a TLS connection, use the @http-client-tls@ package!+    manager <- newManager defaultManagerSettings+    result  <- download (env manager) (Text.pack $ head args)++    case result of+      Left err -> fail (show err)+      Right pl -> print pl++  where+    -- | Create an @Environment@.+    env :: Manager -> Environment+    env m = Environment m limit++    -- | No download limit.+    limit :: Int -> ByteStatus+    limit _ = Continue

+ playlists-http.cabal view

@@ -0,0 +1,77 @@+name:          playlists-http+version:       0.1.0.0+synopsis:      Library to glue together playlists and http-client+homepage:      https://github.com/pjones/playlists-http+license:       BSD3+license-file:  LICENSE+author:        Peter Jones <pjones@devalot.com>+maintainer:    Peter Jones <pjones@devalot.com>+copyright:     Copyright (c) 2016 Peter Jones+category:      Text+build-type:    Simple+cabal-version: >= 1.18+description:   Simple library for resolving playlists using http-client.++--------------------------------------------------------------------------------+extra-source-files:+  AUTHORS+  README.md+  CHANGES.md++--------------------------------------------------------------------------------+source-repository head+  type:     git+  location: https://github.com/pjones/playlists-http.git++--------------------------------------------------------------------------------+flag maintainer+  description: Enable settings for the package maintainer.+  default: False+  manual: True++--------------------------------------------------------------------------------+flag build-examples+  description: Build the example programs.+  default: False+  manual: True++--------------------------------------------------------------------------------+library+  exposed-modules:+    Text.Playlist.HTTP.Simple+    Text.Playlist.HTTP.Full++  default-language: Haskell2010+  hs-source-dirs: src+  ghc-options: -Wall++  if flag(maintainer)+    ghc-options: -Werror++  build-depends: attoparsec   >= 0.10  && < 1.0+               , base         >= 4.6   && < 5+               , bytestring   >= 0.10  && < 1.0+               , either       >= 4.4   && < 4.5+               , exceptions   >= 0.8   && < 0.9+               , http-client  >= 0.4   && < 0.6+               , mtl          >= 2.2   && < 2.3+               , playlists    >= 0.4   && < 0.5+               , text         >= 0.11  && < 1.3++--------------------------------------------------------------------------------+executable example+  default-language: Haskell2010+  hs-source-dirs: examples+  main-is: example.hs+  ghc-options: -Wall++  if flag(maintainer)+    ghc-options: -Werror++  if !flag(build-examples)+    buildable: False+  else+    build-depends: base+                 , http-client+                 , playlists-http+                 , text

+ src/Text/Playlist/HTTP/Full.hs view

@@ -0,0 +1,209 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++{-++This file is part of the Haskell package playlists-http. It is subject to+the license terms in the LICENSE file found in the top-level directory+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part+of playlists-http package, including this file, may be copied, modified,+propagated, or distributed except according to the terms contained in+the LICENSE file.++-}++--------------------------------------------------------------------------------+-- | A more complete interface for recursively downloading a+-- 'Playlist'.  For a simple interface for downloading playlists see+-- 'Text.Playlist.HTTP.Simple'.+module Text.Playlist.HTTP.Full+  ( download+  , Error (..)+  , Environment (..)+  , ByteStatus (..)+  , module Playlist+  ) where++--------------------------------------------------------------------------------+-- Package imports:+import Control.Monad.Catch+import Control.Monad.RWS.Strict+import Control.Monad.Trans.Either+import qualified Data.Attoparsec.ByteString as Atto+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import Data.Text (Text)+import qualified Data.Text as Text+import Network.HTTP.Client+import Text.Playlist as Playlist++--------------------------------------------------------------------------------+-- | Possible error values produced while downloading and resolving a+-- 'Playlist'.+data Error = InvalidURL Text              -- ^ URL could not be parsed.+           | ResponseTooLarge             -- ^ Byte limit exceeded.+           | ProtocolError HttpException  -- ^ HTTP/Network error.+           | FailedToParse String         -- ^ Invalid playlist format.+           | FailedOnException String     -- ^ Unknown exception.+           deriving Show++--------------------------------------------------------------------------------+-- | A status flag used to indicate if a download byte limit has been reached.+data ByteStatus = Continue      -- ^ Continue processing network data.+                | LimitReached  -- ^ Abort playlist processing.++--------------------------------------------------------------------------------+-- | Details needed by the 'download' function to operate.+data Environment = Environment+  { -- | A 'Manager' object from the 'Network.HTTP.Client' library.+    -- If you want the download to take place via a TLS/SSL connection+    -- you need to create the 'Manager' object correctly using the+    -- @http-client-tls@ package.+    httpManager :: Manager++  , -- | A function that is used to limit the number of bytes that are+    -- downloaded while recursively processing playlists.+    --+    -- It is given the current number of bytes that have been+    -- downloaded/processed and should return a 'ByteStatus'.+    httpByteCheck :: Int -> ByteStatus+  }++--------------------------------------------------------------------------------+-- | Internal type used for keeping state.+data State = State+  { httpBytes :: Int+  }++--------------------------------------------------------------------------------+-- | Internal type used for managing state, access to the environment,+-- and access to IO.+newtype Download m a =+  Download { runDownload :: RWST Environment () State (EitherT Error m) a }++  deriving ( Functor+           , Applicative+           , Monad+           , MonadIO+           , MonadReader Environment+           , MonadState State+           )++--------------------------------------------------------------------------------+-- | 'MonadThrow' instance for 'Download'.+instance (Monad m) => MonadThrow (Download m) where+  throwM = Download . lift . left . FailedOnException . show++--------------------------------------------------------------------------------+-- | Internal helper function for getting a result out of a 'Download'+-- computation.  Returns the result and the final state.+runS :: (Monad m)+     => Download m a+     -> Environment+     -> State+     -> m (Either Error (a, State))+runS d e s = do+  result <- runEitherT $ runRWST (runDownload d) e s+  case result of+    Left err         -> return (Left err)+    Right (x, s', _) -> return (Right (x, s'))++--------------------------------------------------------------------------------+-- | Internal helper function for merging the state of one 'Download'+-- computation into another.  Mostly used for when the @m@ value below+-- is two different monads (e.g. generic @MonadIO@ and @IO@).+merge :: (Monad m) => Download m (a, State) -> Download m a+merge k = do+  (x, s) <- k+  put s+  return x++--------------------------------------------------------------------------------+-- | Given an 'Environment' and a URL, recursively download and+-- process a playlist.+--+-- For an example of using this function see the @example.hs@ file+-- included in this package.+download :: forall m. (MonadIO m)+         => Environment+         -> Text+         -> m (Either Error Playlist)+download env startURL = fmap fst <$> runS go env (State 0) where++  ------------------------------------------------------------------------------+  -- | Start playlist processing with the startURL.+  go :: (MonadIO m) => Download m Playlist+  go = resolve [Track startURL Nothing] fetch++  ------------------------------------------------------------------------------+  -- | Turn a URL into a HTTP Request object.+  --+  -- FIXME: Need a MonadCatch here to catch an invalid URL and+  -- return the correct type of Error (InvalidURL).+  request :: Text -> Download m Request+  request = parseRequest . Text.unpack++  ------------------------------------------------------------------------------+  -- | Initiate a HTTP download in IO and then delegate the parsing of+  -- the response body to the parseBody function.+  fetch :: (MonadIO m) => Text -> Download m Playlist+  fetch url = do+    r <- request url+    e <- ask+    s <- get++    -- Some voodoo to make a request in IO and process it in Download.+    merge $ safeIO $ withResponse r (httpManager e) $+      \body -> runS (parseBody url body) e s++  ------------------------------------------------------------------------------+  -- | Like liftIO but catch exceptions and turn them into an Error.+  safeIO :: (MonadIO m) => IO (Either Error a) -> Download m a+  safeIO action = io (catch action stop)+    where+      io a = Download (lift (hoistEither =<< liftIO a))+      stop = return . Left . ProtocolError++--------------------------------------------------------------------------------+-- | Internal helper function to parse the body of a HTTP response.+-- This function is written with @MonadIO m@ but will actually be run+-- directly in @IO@ thanks to 'withResponse' :(+parseBody :: forall m. (MonadIO m)+          => Text+          -> Response BodyReader+          -> Download m Playlist+parseBody url response = do+    parser <- Download (lift (hoistEither lookupParser))+    bytes  <- readChunk+    dispatch (Atto.parse parser bytes)++  where++    ----------------------------------------------------------------------------+    -- | Figure out which parser we should be using.+    lookupParser :: Either Error (Atto.Parser Playlist)+    lookupParser =+      case parserForFormat <$> fileNameToFormat (Text.unpack url) of+        Nothing     -> Left (InvalidURL url)+        Just parser -> Right parser++    ----------------------------------------------------------------------------+    -- | Dispatch an attoparsec response.+    dispatch :: (MonadIO m) => Atto.Result Playlist -> Download m Playlist+    dispatch (Atto.Fail _ _ err) = Download . lift $ left (FailedToParse err)+    dispatch (Atto.Partial f)    = readChunk >>= dispatch . f+    dispatch (Atto.Done _ r)     = return r++    ----------------------------------------------------------------------------+    -- | Read bytes from the HTTP body.+    readChunk :: (MonadIO m) => Download m ByteString+    readChunk = do+      check <- asks httpByteCheck+      count <- gets httpBytes++      case check count of+        LimitReached -> Download . lift $ left ResponseTooLarge+        Continue     -> do+          bytes <- liftIO $ brRead (responseBody response)+          modify' (\s -> s {httpBytes = ByteString.length bytes + count})+          return bytes

+ src/Text/Playlist/HTTP/Simple.hs view

@@ -0,0 +1,51 @@+{-++This file is part of the Haskell package playlists-http. It is subject to+the license terms in the LICENSE file found in the top-level directory+of this distribution and at git://pmade.com/playlists-http/LICENSE. No part+of playlists-http package, including this file, may be copied, modified,+propagated, or distributed except according to the terms contained in+the LICENSE file.++-}++--------------------------------------------------------------------------------+-- | A simple interface for recursively downloading a 'Playlist'.+module Text.Playlist.HTTP.Simple+  ( download+  , module Playlist+  ) where++--------------------------------------------------------------------------------+-- Package imports:+import Data.Text (Text)+import Network.HTTP.Client+import Text.Playlist as Playlist++--------------------------------------------------------------------------------+-- Local imports:+import Text.Playlist.HTTP.Full (Environment(..), ByteStatus(..))+import qualified Text.Playlist.HTTP.Full as Full++--------------------------------------------------------------------------------+-- | Download the playlist whose URL is given in the first argument.+-- If the downloaded playlist references other playlists then it will+-- be recursively processed/downloaded.+--+-- This function will not download more than 5MB total.+--+-- This function does not support TLS/SSL.+--+-- For more control over the download limit, for using TLS/SSL, and+-- for proper error reporting, use the @download@ function from+-- 'Text.Playlist.HTTP.Full'.+download :: Text -> IO (Maybe Playlist)+download url = do+    manager <- newManager defaultManagerSettings+    either (const Nothing) Just <$> Full.download (env manager) url+  where+    env :: Manager -> Environment+    env m = Environment m under5MB++    under5MB :: Int -> ByteStatus+    under5MB n = if n < 5242880 then Continue else LimitReached