diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,1 @@ +Peter Jones (Maintainer) diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,3 @@ +# Version 0.1.0.0 (November 21, 2016) + + * Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016 Peter Jones + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/example.hs b/examples/example.hs new file mode 100644 --- /dev/null +++ b/examples/example.hs @@ -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 diff --git a/playlists-http.cabal b/playlists-http.cabal new file mode 100644 --- /dev/null +++ b/playlists-http.cabal @@ -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 +maintainer: Peter Jones +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 diff --git a/src/Text/Playlist/HTTP/Full.hs b/src/Text/Playlist/HTTP/Full.hs new file mode 100644 --- /dev/null +++ b/src/Text/Playlist/HTTP/Full.hs @@ -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 diff --git a/src/Text/Playlist/HTTP/Simple.hs b/src/Text/Playlist/HTTP/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Text/Playlist/HTTP/Simple.hs @@ -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