Cryptsy/API/Public.hs

   1 {-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving #-}
   2 module Cryptsy.API.Public
   3         ( CryptsyError(..), CryptsyNum(..), E8, PubCryptsy
   4         , parseCryptsyNum, pubCryptsy, pubURL, withNullableArray
   5         , module Network.HTTP.Base
   6         -- |Re-exported from Data.Aeson
   7         , Value, Array
   8         -- |Re-exported from Data.Aeson.Types
   9         , Parser
  10         -- |Re-exported from Data.Fixed
  11         , Fixed
  12         -- |Re-exported from Data.Text
  13         , Text
  14         )
  15 where
  16
  17 -- HTTP
  18 import Network.Browser (BrowserAction, defaultGETRequest_, request)
  19 import Network.HTTP.Base (Response(..))
  20 import Network.TCP (HandleStream)
  21
  22 -- aeson
  23 import Data.Aeson
  24         ( FromJSON(..), Value(Array, Object, Null), Array
  25         , eitherDecode, withText
  26         )
  27 import Data.Aeson.Types (Parser, parseEither, typeMismatch)
  28
  29 -- base
  30 import Data.Fixed (HasResolution(..), Fixed)
  31 import Data.Functor ((<$>))
  32 import Data.Monoid (Monoid(mempty))
  33 import Numeric (readFloat)
  34
  35 -- bytestring
  36 import qualified Data.ByteString.Lazy  as L (ByteString)
  37
  38 -- either
  39 import Control.Monad.Trans.Either (EitherT, left, right, hoistEither)
  40 import Data.Either.Combinators (mapLeft)
  41
  42 -- errors
  43 import Control.Error.Util ((??))
  44
  45 -- network
  46 import Network.URI (parseAbsoluteURI)
  47
  48 -- text
  49 import Data.Text (Text, pack, unpack)
  50
  51 -- transformers
  52 import Control.Monad.Trans (lift)
  53
  54 -- unordered-containers
  55 import qualified Data.HashMap.Strict as HM (lookup)
  56
  57 -- |error conditions w/ debugging information for an API request
  58 data CryptsyError = BadURL { badURL :: String }
  59                   | BadResponse { badResponse :: Response L.ByteString }
  60                   | FailParseResponse { responseBody :: L.ByteString, errorMessage :: String }
  61                   | ErrorResponse { errorValue :: Value }
  62                   | UnsuccessfulResponse { jsonResponse :: Value }
  63                   | FailParseReturn { dataValue :: Value, errorMessage :: String }
  64                   deriving Show
  65
  66 -- |request monad
  67 type PubCryptsy = EitherT CryptsyError (BrowserAction (HandleStream L.ByteString))
  68
  69 -- |generates public API URL
  70 pubURL :: String -- ^ method value
  71        -> String -- ^ complete URL
  72 pubURL = ("http://pubapi.cryptsy.com/api.php?method=" ++)
  73
  74 -- |key in JSON object for return data
  75 dataKey :: Text
  76 dataKey = pack "return"
  77
  78 -- |key in JSON object for error message
  79 errMsgKey :: Text
  80 errMsgKey = pack "error"
  81
  82 -- |common request implementation
  83 pubCryptsy :: String -- ^ URL
  84            -> (Value -> Parser a)
  85            -> PubCryptsy a
  86 pubCryptsy apiurl parser = do
  87         uri <- parseAbsoluteURI apiurl ?? BadURL apiurl
  88         let req = defaultGETRequest_ uri
  89         (_, resp) <- lift $ request req
  90         bodyBytes <- case rspCode resp of
  91                 (2, 0, 0) -> right $ rspBody resp
  92                 _         -> left $ BadResponse resp
  93         valueJSON <- hoistEither . mapLeft (FailParseResponse bodyBytes)
  94                    $ eitherDecode bodyBytes
  95         returnData <- case valueJSON of
  96                 Object (HM.lookup dataKey -> Just dat) -> right dat
  97                 Object (HM.lookup errMsgKey -> Just errMsg) ->
  98                         left $ ErrorResponse errMsg
  99                 _ -> left $ UnsuccessfulResponse valueJSON
 100         hoistEither . mapLeft (FailParseReturn returnData)
 101                     $ parseEither parser returnData
 102
 103 -- |"Native" number type for the API, newtype for custom FromJSON instance
 104 newtype CryptsyNum = CryptsyNum (Fixed E8) deriving
 105         (Eq, Ord, Show, Read, Num, Real, Fractional, Enum, RealFrac)
 106
 107 -- |Custom resolution for 'Fixed'
 108 data E8
 109
 110 instance HasResolution E8 where
 111         -- |1e8
 112         resolution = const 100000000
 113
 114 parseCryptsyNum :: Text -> Parser CryptsyNum
 115 parseCryptsyNum (unpack -> str) =
 116         CryptsyNum <$> case readFloat str of
 117                 []        -> fail "No parse."
 118                 [(f, "")] -> return f
 119                 [(_, _ )] -> fail "Incomplete parse."
 120                 _         -> fail "Ambiguous parse."
 121
 122 instance FromJSON CryptsyNum where
 123         -- |Only accepts Text values
 124         parseJSON = withText "CrypstyNum" parseCryptsyNum
 125
 126 -- |Like 'Data.Aeson.withArray' but also accepting JSON nulls as mempty.
 127 withNullableArray :: (Monoid a)
 128                   => String -> (Array -> Parser a) -> Value -> Parser a
 129 withNullableArray _    parseArray (Array v) = parseArray v
 130 withNullableArray _    _           Null     = return mempty
 131 withNullableArray name _           v        = typeMismatch name v