Cryptsy/API/Public.hs

   1 {-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving #-}
   2 module Cryptsy.API.Public
   3         ( CryptsyError(..), CryptsyNum(..), E8, PubCryptsy
   4         , parseCryptsyNum, pubCryptsy, pubURL
   5         , module Network.HTTP.Base
   6         -- |Re-exported from Data.Aeson
   7         , Value
   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 (FromJSON(..), Value(Object), json, withText)
  24 import Data.Aeson.Types (Parser)
  25
  26 -- attoparsec
  27 import Data.Attoparsec.ByteString.Lazy (eitherResult, parse)
  28
  29 -- base
  30 import Data.Fixed (HasResolution(..), Fixed)
  31 import Data.Functor ((<$>))
  32 import Numeric (readFloat)
  33
  34 -- bytestring
  35 import qualified Data.ByteString.Lazy  as L (ByteString)
  36
  37 -- either
  38 import Control.Monad.Trans.Either (EitherT, left, right)
  39
  40 -- network
  41 import Network.URI (parseAbsoluteURI)
  42
  43 -- text
  44 import Data.Text (Text, pack, unpack)
  45
  46 -- transformers
  47 import Control.Monad.Trans (lift)
  48
  49 -- unordered-containers
  50 import qualified Data.HashMap.Strict as HM (lookup)
  51
  52 -- |error conditions w/ debugging information for an API request
  53 data CryptsyError = BadUrl { url :: String }
  54                   | BadResponse { response :: Response L.ByteString }
  55                   | FailParseResponse { body :: L.ByteString, message :: String }
  56                   | ErrorResponse { error :: Value }
  57                   | UnsuccessfulResponse { jsonResponse :: Value }
  58                   | FailParseReturn { value :: Value, message :: String }
  59                   deriving Show
  60
  61 -- |request monad
  62 type PubCryptsy = EitherT CryptsyError (BrowserAction (HandleStream L.ByteString))
  63
  64 -- |generates public API URL
  65 pubURL :: String -- ^ method value
  66        -> String -- ^ complete URL
  67 pubURL = ("http://pubapi.cryptsy.com/api.php?method=" ++)
  68
  69 -- |key in JSON object for return data
  70 dataKey :: Text
  71 dataKey = pack "return"
  72
  73 -- |key in JSON object for error message
  74 errMsgKey :: Text
  75 errMsgKey = pack "error"
  76
  77 -- |common request implementation
  78 pubCryptsy :: String -- ^ URL
  79            -> PubCryptsy Value
  80 pubCryptsy apiurl = do
  81         uri <- maybe (left $ BadUrl apiurl) right $ parseAbsoluteURI apiurl
  82         let req = defaultGETRequest_ uri
  83         (_, resp) <- lift $ request req
  84         bodyBytes <- case rspCode resp of
  85                 (2, 0, 0) -> right $ rspBody resp
  86                 _         -> left $ BadResponse resp
  87         valueJSON <- either (left . FailParseResponse bodyBytes) right
  88                . eitherResult $ parse json bodyBytes
  89         case valueJSON of
  90                 Object (HM.lookup dataKey -> Just dat) -> right dat
  91                 Object (HM.lookup errMsgKey -> Just errMsg) ->
  92                         left $ ErrorResponse errMsg
  93                 _ -> left $ UnsuccessfulResponse valueJSON
  94
  95 -- |"Native" number type for the API, newtype for custom FromJSON instance
  96 newtype CryptsyNum = CryptsyNum (Fixed E8) deriving
  97         (Eq, Ord, Show, Read, Num, Real, Fractional, Enum, RealFrac)
  98
  99 -- |Custom resolution for 'Fixed'
 100 data E8
 101
 102 instance HasResolution E8 where
 103         -- |1e8
 104         resolution = const 100000000
 105
 106 parseCryptsyNum :: Text -> Parser CryptsyNum
 107 parseCryptsyNum (unpack -> str) =
 108         CryptsyNum <$> case readFloat str of
 109                 []        -> fail "No parse."
 110                 [(f, "")] -> return f
 111                 [(_, _ )] -> fail "Incomplete parse."
 112                 _         -> fail "Ambiguous parse."
 113
 114 instance FromJSON CryptsyNum where
 115         -- |Only accepts Text values
 116         parseJSON = withText "CrypstyNum" parseCryptsyNum