Browse Source

Initial import

tags/v0.1.0.0^0
Peter J. Jones 2 years ago
commit
9f39783cb9
Signed by: Peter Jones <pjones@devalot.com> GPG Key ID: 9DAFAA8D01941E49
12 changed files with 450 additions and 0 deletions
  1. 3
    0
      .gitignore
  2. 1
    0
      AUTHORS
  3. 3
    0
      CHANGES.md
  4. 30
    0
      LICENSE
  5. 16
    0
      README.md
  6. 2
    0
      Setup.hs
  7. 2
    0
      cabal.project
  8. 46
    0
      examples/example.hs
  9. 77
    0
      playlists-http.cabal
  10. 209
    0
      src/Text/Playlist/HTTP/Full.hs
  11. 51
    0
      src/Text/Playlist/HTTP/Simple.hs
  12. 10
    0
      stack.yaml

+ 3
- 0
.gitignore View File

@@ -0,0 +1,3 @@
/.stack-work
/cabal.project.local
/dist-newstyle

+ 1
- 0
AUTHORS View File

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

+ 3
- 0
CHANGES.md View File

@@ -0,0 +1,3 @@
# Version 0.1.0.0 (November 21, 2016)

* Initial release.

+ 30
- 0
LICENSE View File

@@ -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.

+ 16
- 0
README.md View File

@@ -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`.

+ 2
- 0
Setup.hs View File

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

+ 2
- 0
cabal.project View File

@@ -0,0 +1,2 @@
packages: ./
../playlists

+ 46
- 0
examples/example.hs View File

@@ -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

+ 77
- 0
playlists-http.cabal View File

@@ -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

+ 209
- 0
src/Text/Playlist/HTTP/Full.hs View File

@@ -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

+ 51
- 0
src/Text/Playlist/HTTP/Simple.hs View File

@@ -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

+ 10
- 0
stack.yaml View File

@@ -0,0 +1,10 @@
resolver: lts-6.25

packages:
- ../playlists
- ./

flags:
playlists-http:
maintainer: true
build-examples: true

Loading…
Cancel
Save