diff --git a/cryptsy-api.cabal b/cryptsy-api.cabal --- a/cryptsy-api.cabal +++ b/cryptsy-api.cabal @@ -1,5 +1,5 @@ name: cryptsy-api -version: 0.1 +version: 0.2 synopsis: Bindings for Cryptsy cryptocurrency exchange API. description: Bindings for Cryptsy cryptocurrency exchange API. license: OtherLicense @@ -39,18 +39,19 @@ , Cryptsy.API.Public.Types.Internal build-depends: base ==4.6.* - , HTTP ==4000.2.* - , either ==4.0.* - , text ==0.11.* - , transformers ==0.3.* - , unordered-containers ==0.2.* - , vector ==0.10.* - , aeson ==0.6.* - , errors ==1.4.* - , network ==2.4.* + , aeson >= 0.6 && < 0.8 , bytestring ==0.10.* , deepseq ==1.3.* + , either >= 4.0 && < 4.2 + , http-client ==0.2.* + , http-client-tls ==0.2.* , old-locale ==1.0.* + , pipes-attoparsec ==0.4.* + , pipes-http ==1.0.* + , text >= 0.11 && < 1.2 , time ==1.4.* + , transformers ==0.3.* + , unordered-containers ==0.2.* + , vector ==0.10.* hs-source-dirs: src diff --git a/src/Cryptsy/API/Public.hs b/src/Cryptsy/API/Public.hs --- a/src/Cryptsy/API/Public.hs +++ b/src/Cryptsy/API/Public.hs @@ -6,12 +6,55 @@ , module Cryptsy.API.Public.Market , module Cryptsy.API.Public.OrderData , module Cryptsy.API.Public.OrderBook + , defaultEvalPubCryptsy + , defaultRunPubCryptsy ) where +-- base +import Data.Maybe (fromMaybe) +import Data.Monoid (mempty) + +-- either +import Control.Monad.Trans.Either (runEitherT) + +-- http-client +import Network.HTTP.Client (CookieJar, withManager) + +-- http-client-tls +import Network.HTTP.Client.TLS (tlsManagerSettings) + +-- transformers +import Control.Monad.Trans.Reader (runReaderT) +import Control.Monad.Trans.State (runStateT) + +-- this package import Cryptsy.API.Public.Market import Cryptsy.API.Public.MarketData.New import Cryptsy.API.Public.MarketData.Old import Cryptsy.API.Public.OrderBook import Cryptsy.API.Public.OrderData import Cryptsy.API.Public.Types + +{-| +Like 'defaultRunPubCryptsy', but the resulting cookir jar is ignored. +-} +defaultEvalPubCryptsy :: PubCryptsy a -> IO (Either CryptsyError a) +defaultEvalPubCryptsy = fmap fst . defaultRunPubCryptsy +{-# INLINABLE defaultEvalPubCryptsy #-} + +{-| +Converts a public cryptsy action to an action in the IO Monad, using a new +manager created from 'tlsManagerSettings' and closed as the last part of the IO +action and starting from an empty cookie jar. Both the resulting cookie jar +and either the resolt of the public cryptsy action or the first cryptsy error +encountered are the results of the IO action. +-} +defaultRunPubCryptsy :: PubCryptsy a -> IO (Either CryptsyError a, CookieJar) +defaultRunPubCryptsy = withManager tlsManagerSettings + . (defaultRunInReader .) . runReaderT + where + defaultRunInReader = fmap (msnd (fromMaybe mempty)) . ($ Just mempty) + . runStateT . runEitherT + msnd f (x, y) = (x, f y) +{-# INLINABLE defaultRunPubCryptsy #-} diff --git a/src/Cryptsy/API/Public/Internal.hs b/src/Cryptsy/API/Public/Internal.hs --- a/src/Cryptsy/API/Public/Internal.hs +++ b/src/Cryptsy/API/Public/Internal.hs @@ -2,29 +2,36 @@ -- |Implementations shared across two or more modules. module Cryptsy.API.Public.Internal where --- HTTP -import Network.Browser (request) -import Network.HTTP.Base (defaultGETRequest_, rspBody, rspCode) +-- base +import Control.Exception (try) +import Data.Functor ((<$)) -- aeson -import Data.Aeson (Value(Object), eitherDecode, withObject) +import Data.Aeson (Value(Object), withObject, json') import Data.Aeson.Types (Parser, parseEither) -- either -import Control.Monad.Trans.Either (hoistEither, left, right) +import Control.Monad.Trans.Either (EitherT(..), hoistEither) import Data.Either.Combinators (mapLeft) --- errors -import Control.Error.Util ((??)) +-- http-client +import Network.HTTP.Client + ( cookieJar, parseUrl, responseBody, responseCookieJar + ) --- network -import Network.URI (parseAbsoluteURI) +-- pipes-attoparsec +import Pipes.Attoparsec (parse) +-- pipes-http +import Pipes.HTTP (withHTTP) + -- text import Data.Text (Text, pack) -- transformers -import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Reader (ReaderT(..)) +import Control.Monad.Trans.State (StateT(..)) +import Control.Monad.Trans.State.Strict (evalStateT) -- unordered-containers import qualified Data.HashMap.Strict as HM (lookup) @@ -55,22 +62,25 @@ pubCryptsy :: String -- ^ URL -> (Value -> Parser a) -> PubCryptsy a -pubCryptsy apiurl parser = do - uri <- parseAbsoluteURI apiurl ?? BadURL apiurl - let req = defaultGETRequest_ uri - (_, resp) <- lift $ request req - bodyBytes <- case rspCode resp of - (2, 0, 0) -> right $ rspBody resp - _ -> left $ BadResponse resp - valueJSON <- hoistEither . mapLeft (FailParseResponse bodyBytes) - $ eitherDecode bodyBytes - returnData <- case valueJSON of - Object (HM.lookup dataKey -> Just dat) -> right dat - Object (HM.lookup errMsgKey -> Just errMsg) -> - left $ ErrorResponse errMsg - _ -> left $ UnsuccessfulResponse valueJSON - hoistEither . mapLeft (FailParseReturn returnData) - $ parseEither parser returnData +pubCryptsy apiurl parser = ReaderT $ \manager -> do + reqSansCookies <- hoistEither . mapLeft (BadURL apiurl) $ parseUrl apiurl + parseResult <- EitherT . StateT $ \beforeCookies -> do + let req = reqSansCookies { cookieJar = beforeCookies } + thttp <- try . withHTTP req manager $ \resp -> do + tpr <- try . evalStateT (parse json') $ responseBody resp -- discard lo + return (tpr, responseCookieJar resp <$ beforeCookies) + return $ case thttp of + Left he -> (Left $ FailReadResponse req he, beforeCookies) + Right (Left he, nc) -> (Left $ FailReadResponse req he, nc) + Right (Right pr, nc) -> (Right pr, nc) + hoistEither $ do + value <- mapLeft FailParseResponse parseResult + dat <- case value of + Object (HM.lookup dataKey -> Just d) -> Right d + Object (HM.lookup errMsgKey -> Just errMsg) -> + Left $ ErrorResponse errMsg + _ -> Left $ UnsuccessfulResponse value + mapLeft (FailParseReturn dat) $ parseEither parser dat {-# INLINABLE pubCryptsy #-} -- |unpacked 'marketsKey' diff --git a/src/Cryptsy/API/Public/Types/Error.hs b/src/Cryptsy/API/Public/Types/Error.hs --- a/src/Cryptsy/API/Public/Types/Error.hs +++ b/src/Cryptsy/API/Public/Types/Error.hs @@ -1,19 +1,19 @@ -- |Sum type for any error conditions in a API request. module Cryptsy.API.Public.Types.Error where --- HTTP -import Network.HTTP.Base (Response) - -- aeson import Data.Aeson (Value) --- bytestring -import Data.ByteString.Lazy (ByteString) +-- http-client +import Network.HTTP.Client (HttpException, Request) +-- pipes-attoparsec +import Pipes.Attoparsec (ParsingError) + -- |error conditions w/ debugging information for an API request -data CryptsyError = BadURL { badURL :: String } - | BadResponse { badResponse :: Response ByteString } - | FailParseResponse { responseBody :: ByteString, errorMessage :: String } +data CryptsyError = BadURL { badURL :: String, httpException :: HttpException } + | FailReadResponse { request :: Request, httpException :: HttpException } + | FailParseResponse { parsingError :: ParsingError } | ErrorResponse { errorValue :: Value } | UnsuccessfulResponse { jsonResponse :: Value } | FailParseReturn { dataValue :: Value, errorMessage :: String } diff --git a/src/Cryptsy/API/Public/Types/Monad.hs b/src/Cryptsy/API/Public/Types/Monad.hs --- a/src/Cryptsy/API/Public/Types/Monad.hs +++ b/src/Cryptsy/API/Public/Types/Monad.hs @@ -5,18 +5,18 @@ ) where --- HTTP -import Network.Browser (BrowserAction) -import Network.TCP (HandleStream) - --- bytestring -import Data.ByteString.Lazy (ByteString) - -- either import Control.Monad.Trans.Either (EitherT) +-- http-client +import Network.HTTP.Client (CookieJar, Manager) + +-- transformers +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.State (StateT) + -- this package import Cryptsy.API.Public.Types.Error -- |request monad -type PubCryptsy = EitherT CryptsyError (BrowserAction (HandleStream ByteString)) +type PubCryptsy = ReaderT Manager (EitherT CryptsyError (StateT (Maybe CookieJar) IO)) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,27 +1,13 @@ -module Main where +module Main (main) where -- base import Control.Monad ((<=<)) --- HTTP -import Network.HTTP.Base (httpPackageVersion) - -import Network.Browser - ( Proxy(NoProxy), BrowserAction - , browse, setAllowRedirects, setMaxRedirects, setAuthorities - , setAllowBasicAuth, setMaxErrorRetries, setMaxPoolSize - , setMaxAuthAttempts, setProxy, setOutHandler, setUserAgent - ) - --- either -import Control.Monad.Trans.Either (runEitherT) - -- text import Data.Text (pack) -- transformers import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) -- unordered-containers import qualified Data.HashMap.Strict as HM @@ -32,22 +18,8 @@ -- this package import Cryptsy.API.Public -initBrowser :: BrowserAction t () -initBrowser = do - setAllowRedirects True - setMaxRedirects $ Just 10 - setAuthorities [] - setAllowBasicAuth False - setMaxErrorRetries $ Just 0 - setMaxPoolSize $ Just 2 - setMaxAuthAttempts $ Just 0 - setProxy NoProxy - setOutHandler . const $ return () - setUserAgent $ "Network.Browser/" ++ httpPackageVersion - main :: IO () -main = either print return <=< browse . runEitherT $ do - lift initBrowser +main = either print return <=< defaultEvalPubCryptsy $ do books <- orderData liftIO . print . HM.size $ orderBooks (books :: OrderData) omkts <- oldMarketData