Main.hs

   1 {-# LANGUAGE ViewPatterns, NoMonomorphismRestriction #-}
   2 module Main
   3 ( main
   4 )
   5 where
   6
   7 -- base
   8 import Control.Applicative ((<*>))
   9 import Control.Monad (Monad, return, (<=<))
  10 import Data.Bool (Bool(False, True))
  11 import Data.Either (either)
  12 import Data.Foldable (foldMap)
  13 import Data.Function (const, id, on)
  14 import Data.Functor (fmap, (<$>))
  15 import Data.List (minimum, maximum)
  16 import Data.Maybe (Maybe(Nothing, Just), catMaybes, mapMaybe)
  17 import Data.Monoid (Monoid(..), Sum(..), (<>))
  18 import Data.Ord (Ord(..), min, max)
  19 import Data.Tuple (curry, uncurry)
  20 import Prelude
  21         ( Num, Show(show), Fractional(fromRational)
  22         , Integer, String, IO
  23         , print, putStr, putStrLn, read, take, undefined
  24         , (.), ($)
  25         ,
  26         )
  27
  28 -- bytestring
  29 import qualified Data.ByteString       as BS
  30 import qualified Data.ByteString.Char8 as CS
  31
  32 -- network
  33 import Network.URI (URI, parseAbsoluteURI)
  34
  35 -- Crypto
  36 import Codec.Utils (Octet)
  37 import Data.HMAC (HashMethod(..), hmac)
  38 import qualified Data.Digest.SHA512 as SHA512 (hash)
  39
  40 -- HTTP
  41 import Network.HTTP.Base
  42         ( Request(..), Response(..), RequestMethod(..)
  43         , urlEncodeVars, httpPackageVersion
  44         )
  45
  46 import Network.HTTP.Headers (Header(Header), HeaderName(HdrCustom))
  47
  48 import qualified Network.Browser as Browser (request)
  49 import           Network.Browser
  50         ( Proxy(NoProxy), BrowserAction
  51         , browse, setAllowRedirects, setMaxRedirects, setAuthorities
  52         , setAllowBasicAuth, setMaxErrorRetries, setMaxPoolSize
  53         , setMaxAuthAttempts, setProxy, setOutHandler, setUserAgent
  54         )
  55
  56 -- either
  57 import Control.Monad.Trans.Either
  58         ( EitherT(..), bimapEitherT, eitherT, runEitherT, hoistEither
  59         )
  60
  61 -- errors
  62 import Control.Error.Util (note)
  63
  64 -- text
  65 import qualified Data.Text as T
  66
  67 -- transformers
  68 import Control.Monad.IO.Class (liftIO)
  69 import Control.Monad.Trans.Class (lift)
  70
  71 -- unordered-containers
  72 import qualified Data.HashMap.Strict as HM (lookup, size)
  73
  74 -- vector
  75 import qualified Data.Vector as V (length)
  76
  77 -- this package
  78 import Cryptsy.API.Public.MarketData.New
  79 import qualified Cryptsy.API.Public.MarketData.Old as Old
  80 import           Cryptsy.API.Public.Market (singleMarket)
  81 import qualified Cryptsy.API.Public.Market as Market
  82 import Cryptsy.API.Public.OrderData
  83 import           Cryptsy.API.Public.OrderBook (singleOrderBook)
  84 import qualified Cryptsy.API.Public.OrderBook as OrderBook
  85 import qualified Cryptsy.API.Public.Trade as Trade
  86         ( price, quantity, total )
  87
  88 apiUrl :: String
  89 apiUrl = "https://www.cryptsy.com/api"
  90
  91 mUri :: Maybe URI
  92 mUri = parseAbsoluteURI apiUrl
  93
  94 apiPubkey :: String
  95 apiPubkey = "5a8808b25e3f59d8818d3fbc0ce993fbb82dcf90"
  96
  97 apiPrivkey :: String
  98 apiPrivkey = ""
  99
 100 get_nonce :: IO Integer
 101 get_nonce = do
 102         return 1
 103
 104 method :: String
 105 method = "getinfo"
 106
 107 sha512_hm :: HashMethod
 108 sha512_hm = HashMethod
 109         { digest = SHA512.hash
 110         , input_blocksize = 1024
 111         }
 112
 113 hexdump :: [Octet] -> String
 114 hexdump = mconcat . fmap show2Hex
 115  where
 116         show2Hex = undefined
 117
 118 readHex :: String -> Maybe [Octet]
 119 readHex = undefined
 120
 121 oldMain :: IO ()
 122 oldMain = case (readHex apiPrivkey, mUri) of
 123         (_, Nothing) -> do
 124                 putStr apiUrl
 125                 putStrLn " could not be parsed as an absolute URI."
 126         (Nothing, _) ->
 127                 putStrLn "<apiPrivkey> could not be parsed as hex."
 128         (Just pk, Just uri) -> do
 129                 nonce <- get_nonce
 130                 let
 131                         postString = urlEncodeVars [ ("nonce", show nonce) ]
 132                         postSig = hexdump . hmac sha512_hm pk . BS.unpack $ CS.pack postString
 133                         request = Request
 134                                 { rqURI = uri
 135                                 , rqMethod = POST
 136                                 , rqHeaders =
 137                                         [ Header (HdrCustom "Key" ) apiPubkey
 138                                         , Header (HdrCustom "Sign") postSig
 139                                         ]
 140                                 , rqBody = postString
 141                                 }
 142                 myBody <- browse $ do
 143                         initBrowser
 144                         (_, theResponse) <- Browser.request request
 145                         return $ rspBody theResponse
 146                 putStrLn myBody
 147
 148 initBrowser :: BrowserAction t ()
 149 initBrowser = do
 150         setAllowRedirects True
 151         setMaxRedirects $ Just 10
 152         setAuthorities []
 153         setAllowBasicAuth False
 154         setMaxErrorRetries $ Just 0
 155         setMaxPoolSize $ Just 2
 156         setMaxAuthAttempts $ Just 0
 157         setProxy NoProxy
 158         setOutHandler . const $ return ()
 159         setUserAgent $ "Network.Browser/" <> httpPackageVersion
 160
 161 newtype Min n = Min { getMin :: Maybe n } deriving Show
 162 instance Ord n => Monoid (Min n) where
 163         mempty = Min Nothing
 164         mappend (Min  Nothing)  m             = m
 165         mappend  m             (Min  Nothing) = m
 166         mappend (Min (Just m)) (Min (Just n)) = Min . Just $ min m n
 167         mconcat []   = Min Nothing
 168         mconcat mins = Min . Just . minimum . catMaybes $ fmap getMin mins
 169
 170 newtype Max n = Max { getMax :: Maybe n } deriving Show
 171 instance Ord n => Monoid (Max n) where
 172         mempty = Max Nothing
 173         mappend (Max  Nothing)  m             = m
 174         mappend  m             (Max  Nothing) = m
 175         mappend (Max (Just m)) (Max (Just n)) = Max . Just $ max m n
 176         mconcat []   = Max Nothing
 177         mconcat maxs = Max . Just . maximum $ mapMaybe getMax maxs
 178
 179 data MarketSummary p q t = MarketSummary
 180         { minPrice :: Min p
 181         , maxPrice :: Max p
 182         , count :: Sum Integer
 183         , primaryVolume :: Sum q
 184         , secondaryVolume :: Sum t
 185         } deriving Show
 186 instance (Ord p, Num q, Num t) => Monoid (MarketSummary p q t) where
 187         mempty  = MarketSummary
 188                   mempty
 189                   mempty
 190                   mempty
 191                   mempty
 192                   mempty
 193         mappend = curry $ MarketSummary <$>
 194                   uncurry (mappend `on` minPrice) <*>
 195                   uncurry (mappend `on` maxPrice) <*>
 196                   uncurry (mappend `on` count) <*>
 197                   uncurry (mappend `on` primaryVolume) <*>
 198                   uncurry (mappend `on` secondaryVolume)
 199         mconcat = MarketSummary <$>
 200                   (mconcat . fmap minPrice) <*>
 201                   (mconcat . fmap maxPrice) <*>
 202                   (mconcat . fmap count) <*>
 203                   (mconcat . fmap primaryVolume) <*>
 204                   (mconcat . fmap secondaryVolume)
 205
 206 tradeSummary :: GTrade dt p q t -> MarketSummary p q t
 207 tradeSummary trade = MarketSummary
 208         { minPrice = Min . Just $ Trade.price trade
 209         , maxPrice = Max . Just $ Trade.price trade
 210         , count = Sum 1
 211         , primaryVolume = Sum $ Trade.quantity trade
 212         , secondaryVolume = Sum $ Trade.total trade
 213         }
 214
 215 main :: IO ()
 216 main = either print return <=< browse . runEitherT $ do
 217         lift $ initBrowser
 218         books <- jsonOrderData
 219         liftIO . print . HM.size $ orderbooks (books :: OrderData)
 220         omkts <- Old.jsonMarketData
 221         liftIO . print . HM.size $ Old.markets (omkts :: MarketData)
 222         mkts <- jsonMarketData
 223         liftIO . print . HM.size $ markets (mkts :: MarketData)
 224         book <- singleOrderBook $ T.pack "113"
 225         liftIO . print $ ( V.length $ OrderBook.buyorders (book :: OrderBook)
 226                          , V.length $ OrderBook.sellorders book
 227                          )
 228         market <- singleMarket $ T.pack "113"
 229         liftIO . print $ ( V.length $ recenttrades (market :: Market)
 230                          , V.length $ Market.buyorders market
 231                          , V.length $ Market.sellorders market
 232                          )