BittrexAPI.hs

--------------------------------------------------------------------------------

{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE RoleAnnotations            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

--------------------------------------------------------------------------------

module BittrexAPI where

--------------------------------------------------------------------------------

import           Data.Aeson                 ((.:), (.=))
import qualified Data.Aeson                 as Aeson
import qualified Data.Aeson.Types           as Aeson

import qualified Data.Aeson.BetterErrors    as AesonBE

import           Data.Scientific            (Scientific)

import           Data.Int
import           Data.Word

import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import qualified Data.Text.Encoding         as Text

import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as LBS

import           Data.Vector                (Vector)
import qualified Data.Vector                as Vector

import qualified Data.UUID                  as UUID

--------------------------------------------------------------------------------

import           Control.Monad.Catch

import qualified Control.Monad.Reader.Class as MonadReader

--------------------------------------------------------------------------------

import           Servant                    ((:<|>) ((:<|>)), (:>))
import qualified Servant                    as S
import qualified Servant.Client             as S
import qualified Servant.Docs               as S
import qualified Servant.Server             as S
import qualified Servant.Server.Internal    as S.Internal

import qualified Network.Wai                as WAI

--------------------------------------------------------------------------------

import qualified Composite                  as Comp
import qualified Composite.Aeson            as Comp
import           Composite.Record
                 (pattern (:*:), (:->), Rec (RNil), Record)

--------------------------------------------------------------------------------

import           Control.DeepSeq            (NFData)
import           Data.Binary                (Binary)
import           Data.Data                  (Data)
import           Data.Hashable              (Hashable)
import           Foreign.Storable           (Storable)
import           GHC.Generics               (Generic)
import           System.Random              (Random)

import           Data.Kind                  (Constraint, Type)

import           GHC.TypeLits               (KnownSymbol, Symbol, symbolVal)

import           GHC.TypeLits
                 (ErrorMessage ((:$$:), (:<>:), ShowType, Text), TypeError)

import           Data.Proxy                 (Proxy (Proxy))

--------------------------------------------------------------------------------

import           Data.Maybe
import           Data.Monoid

import           Data.Foldable              (asum)

import           Flow

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- SERVANT API TYPES -----------------------------------------------------------
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

getMarkets           :: S.ClientM (Response (Vector Market))
getCurrencies        :: S.ClientM (Response (Vector Currency))
getTicker            :: Req MarketName
                     -> S.ClientM (Response Ticker)
getMarketSummaries   :: S.ClientM (Response (Vector MarketSummary))
getMarketSummary     :: Req MarketName
                     -> S.ClientM (Response (List1 MarketSummary))
getOrderBook         :: Req MarketName
                     -> Req OrderBookType
                     -> S.ClientM (Response OrderBook)
getMarketHistory     :: Req MarketName
                     -> S.ClientM (Response (Vector Trade))

buyLimit             :: Req APIKey
                     -> Req MarketName
                     -> Req Quantity
                     -> Req Quantity
                     -> S.ClientM (Response OrderUUID)
sellLimit            :: Req APIKey
                     -> Req MarketName
                     -> Req Quantity
                     -> Req Quantity
                     -> S.ClientM (Response OrderUUID)
cancel               :: Req APIKey
                     -> Req UUID
                     -> S.ClientM (Response Null)
getOpenOrders        :: Req APIKey
                     -> Opt MarketName
                     -> S.ClientM (Response (Vector OpenOrder))

getBalances          :: Req APIKey
                     -> S.ClientM (Response (Vector Balance))
getBalance           :: Req APIKey
                     -> Req SCurrencyName
                     -> S.ClientM (Response Balance)
getDepositAddress    :: Req APIKey
                     -> Req SCurrencyName
                     -> S.ClientM (Response DepositAddress)
withdraw             :: Req APIKey
                     -> Req SCurrencyName
                     -> Req Quantity
                     -> Req Text
                     -> Opt Text
                     -> S.ClientM (Response WithdrawalUUID)
getOrder             :: Req APIKey
                     -> Req UUID
                     -> S.ClientM (Response OrderDetail)
getOrderHistory      :: Req APIKey
                     -> Opt MarketName
                     -> S.ClientM (Response ClosedOrder)
getWithdrawalHistory :: Req APIKey
                     -> Opt SCurrencyName
                     -> S.ClientM (Response (Vector Withdrawal))
getDepositHistory    :: Req APIKey
                     -> Opt SCurrencyName
                     -> S.ClientM (Response (Vector Deposit))

(      (      getMarkets
         :<|> getCurrencies
         :<|> getTicker
         :<|> getMarketSummaries
         :<|> getMarketSummary
         :<|> getOrderBook
         :<|> getMarketHistory
       )
  :<|> (      buyLimit
         :<|> sellLimit
         :<|> cancel
         :<|> getOpenOrders
       )
  :<|> (      getBalances
         :<|> getBalance
         :<|> getDepositAddress
         :<|> withdraw
         :<|> getOrder
         :<|> getOrderHistory
         :<|> getWithdrawalHistory
         :<|> getDepositHistory
       )
  ) = S.client (Proxy @API)

type Req a = a
type Opt a = Maybe a

--------------------------------------------------------------------------------

type API
  = (      ("public"  :> PublicAPI)
      :<|> ("market"  :> MarketAPI)
      :<|> ("account" :> AccountAPI)
    )

type PublicAPI
  = (      ("getmarkets"
            :> BGet (Vector Market))
      :<|> ("getcurrencies"
            :> BGet (Vector Currency))
      :<|> ("getticker"
            :> ReqQP "market" MarketName
            :> BGet Ticker)
      :<|> ("getmarketsummaries"
            :> BGet (Vector MarketSummary))
      :<|> ("getmarketsummary"
            :> ReqQP "market" MarketName
            :> BGet (List1 MarketSummary))
      :<|> ("getorderbook"
            :> ReqQP "market" MarketName
            :> ReqQP "type"   OrderBookType
            :> BGet OrderBook)
      :<|> ("getmarkethistory"
            :> ReqQP "market" MarketName
            :> BGet (Vector Trade))
    )

type MarketAPI
  = (      ("buylimit"
            :> WithAPIKey
            :> ReqQP "market"   MarketName
            :> ReqQP "quantity" Quantity
            :> ReqQP "rate"     Quantity
            :> BGet OrderUUID)
      :<|> ("selllimit"
            :> WithAPIKey
            :> ReqQP "market"   MarketName
            :> ReqQP "quantity" Quantity
            :> ReqQP "rate"     Quantity
            :> BGet OrderUUID)
      :<|> ("cancel"
            :> WithAPIKey
            :> ReqQP "uuid" UUID
            :> BGet Null)
      :<|> ("getopenorders"
            :> WithAPIKey
            :> OptQP "market" MarketName
            :> BGet (Vector OpenOrder))
    )

type AccountAPI
  = (      ("getbalances"
            :> WithAPIKey
            :> BGet (Vector Balance))
      :<|> ("getbalance"
            :> WithAPIKey
            :> ReqQP "currency" SCurrencyName
            :> BGet Balance)
      :<|> ("getdepositaddress"
            :> WithAPIKey
            :> ReqQP "currency" SCurrencyName
            :> BGet DepositAddress)
      :<|> ("withdraw"
            :> WithAPIKey
            :> ReqQP "currency"  SCurrencyName
            :> ReqQP "quantity"  Quantity
            :> ReqQP "address"   Text -- FIXME
            :> OptQP "paymentid" Text -- FIXME
            :> BGet WithdrawalUUID)
      :<|> ("getorder"
            :> WithAPIKey
            :> ReqQP "uuid" UUID
            :> BGet OrderDetail)
      :<|> ("getorderhistory"
            :> WithAPIKey
            :> OptQP "market" MarketName
            :> BGet ClosedOrder)
      :<|> ("getwithdrawalhistory"
            :> WithAPIKey
            :> OptQP "currency" SCurrencyName
            :> BGet (Vector Withdrawal))
      :<|> ("getdeposithistory"
            :> WithAPIKey
            :> OptQP "currency" SCurrencyName
            :> BGet (Vector Deposit))
    )

--------------------------------------------------------------------------------

type BGet t = S.Get '[JSONBE] (Response t)
type OptQP param ty = S.QueryParam param ty
type ReqQP param ty = ReqQueryParam param ty

type WithAPIKey = ReqQP "apikey" APIKey

type APIKey = Text

--------------------------------------------------------------------------------

-- Switch to https://github.com/haskell-servant/servant/pull/873
-- once it is merged and upstreamed.
-- That will give us a HasServer instance and a better HasDocs instance.

type role ReqQueryParam phantom phantom
data ReqQueryParam (sym :: Symbol) a

instance ( KnownSymbol sym, S.ToParam (S.QueryParam sym v), S.HasDocs api
         ) => S.HasDocs (ReqQueryParam sym v :> api) where
  docsFor _ = S.docsFor (Proxy @(S.QueryParam sym v :> api))

instance ( KnownSymbol sym, S.ToHttpApiData v, S.HasClient api
         ) => S.HasClient (ReqQueryParam sym v :> api) where
  type Client (ReqQueryParam sym v :> api) = (v -> S.Client api)
  clientWithRoute _ r v
    = S.clientWithRoute (Proxy @(S.QueryParam sym v :> api)) r (Just v)

instance ( KnownSymbol sym, S.ToHttpApiData v, S.HasLink api
         ) => S.HasLink (ReqQueryParam sym v :> api) where
  type MkLink (ReqQueryParam sym v :> api) = (v -> S.MkLink api)
  toLink _ l v = S.toLink (Proxy @(S.QueryParam sym v :> api)) l (Just v)

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- GENERAL API DATA TYPES ------------------------------------------------------
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

data Null
  = Null
  deriving (Eq, Ord, Show, Read, Generic)

instance Hashable Null

instance ParseJSON Null where
  parseJSON = AesonBE.asNull >> pure Null

instance Aeson.ToJSON Null where
  toJSON Null = Aeson.Null

--------------------------------------------------------------------------------

data List1 t
  = List1 t
  deriving (Eq, Ord, Show, Read, Generic)

instance (Hashable t) => Hashable (List1 t)

instance (ParseJSON t) => ParseJSON (List1 t) where
  parseJSON = do
    xs <- AesonBE.eachInArray parseJSON
    case  xs of
      [x] -> pure (List1 x)
      _   -> Text.pack ("List1: wrong size of list: " <> show (length xs))
             |> JSONParseError |> AesonBE.throwCustomError

instance (Aeson.ToJSON t) => Aeson.ToJSON (List1 t) where
  toJSON (List1 t) = Aeson.toJSON [t]

--------------------------------------------------------------------------------

newtype UUID
  = UUID { getUUID :: UUID.UUID }
  deriving (Eq, Ord, Read, Show, Storable, Binary, NFData, Hashable, Random)

printUUID :: UUID -> Text
printUUID = getUUID .> UUID.toText

parseUUID :: Text -> Maybe UUID
parseUUID = UUID.fromText .> fmap UUID

instance ParseJSON UUID where
  parseJSON = do
    t <- AesonBE.asText
    let err = Text.pack ("UUID: failed to parse: " <> show t)
              |> JSONParseError |> AesonBE.throwCustomError
    parseUUID t |> maybe err pure

instance Aeson.ToJSON UUID where
  toJSON = printUUID .> Aeson.toJSON

instance S.ToHttpApiData UUID where
  toQueryParam = printUUID

instance S.FromHttpApiData UUID where
  parseQueryParam t = parseUUID t
                      |> maybe (Left ("error parsing UUID: " <> t)) Right

--------------------------------------------------------------------------------

-- "2014-02-13T00:00:00"
type TimeStamp = Text -- FIXME: use proper timestamp type

--------------------------------------------------------------------------------

newtype Quantity
  = Quantity { fromQuantity :: Scientific }
  deriving ( Eq, Ord, Num, Show, Read, Generic
           , Aeson.ToJSON, Aeson.FromJSON )

instance ParseJSON Quantity where
  parseJSON = Quantity <$> parseJSON

instance S.ToHttpApiData Quantity where
  toQueryParam = fromQuantity .> show .> Text.pack

instance S.FromHttpApiData Quantity where
  parseQueryParam t = Text.encodeUtf8 ("\"" <> t <> "\"")
                      |> LBS.fromStrict
                      |> Aeson.decode
                      |> fmap Quantity
                      |> maybe (Left ("error parsing Quantity: " <> t)) Right

--------------------------------------------------------------------------------

type Response t
  = Record '[ "success" :-> Bool
            , "message" :-> Text
            , "result"  :-> t
            ]

--------------------------------------------------------------------------------

type SCurrencyName = Text -- "LTC"
type LCurrencyName = Text -- "Litecoin"

--------------------------------------------------------------------------------

-- "BTC-LTC"
data MarketName
  = MarketName
    { _MarketName_base   :: SCurrencyName -- "BTC"
    , _MarketName_market :: SCurrencyName -- "LTC"
    }
  deriving ()

printMarketName :: MarketName -> Text
printMarketName (MarketName b m) = b <> "-" <> m

parseMarketName :: Text -> Maybe MarketName
parseMarketName t = case Text.split (== '-') t of
                      [b, m] -> Just (MarketName b m)
                      _      -> Nothing

instance ParseJSON MarketName where
  parseJSON = do
    t <- AesonBE.asText
    let err = Text.pack ("MarketName: failed to parse: " <> show t)
              |> JSONParseError |> AesonBE.throwCustomError
    parseMarketName t |> maybe err pure

instance Aeson.ToJSON MarketName where
  toJSON mn = Aeson.String (printMarketName mn)

instance S.ToHttpApiData MarketName where
  toQueryParam = printMarketName

instance S.FromHttpApiData MarketName where
  parseQueryParam t
    = parseMarketName t
      |> maybe (Left ("MarketName: failed to parse: " <> t)) Right

--------------------------------------------------------------------------------



--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- PUBLIC API DATA TYPES -------------------------------------------------------
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

type Market
  = Record '[ "MarketCurrency"     :-> SCurrencyName -- "LTC"
            , "BaseCurrency"       :-> SCurrencyName -- "BTC"
            , "MarketCurrencyLong" :-> LCurrencyName -- "Litecoin"
            , "BaseCurrencyLong"   :-> LCurrencyName -- "Bitcoin"
            , "MinTradeSize"       :-> Quantity
            , "MarketName"         :-> MarketName -- "BTC-LTC"
            , "IsActive"           :-> Bool
            , "Created"            :-> TimeStamp
            ]

--------------------------------------------------------------------------------

type Currency
  = Record '[ "Currency"        :-> SCurrencyName -- "BTC"
            , "CurrencyLong"    :-> LCurrencyName -- "Bitcoin"
            , "MinConfirmation" :-> Word64
            , "TxFee"           :-> Quantity -- 0.00020000
            , "IsActive"        :-> Bool
            , "CoinType"        :-> Text -- "BITCOIN"
            , "BaseAddress"     :-> Null -- null?
            ]

--------------------------------------------------------------------------------

type Ticker
  = Record '[ "Bid"  :-> Quantity
            , "Ask"  :-> Quantity
            , "Last" :-> Quantity
            ]

--------------------------------------------------------------------------------

type MarketSummary
  = Record '[ "MarketName"        :-> MarketName -- "BTC-LTC"
            , "High"              :-> Quantity
            , "Low"               :-> Quantity
            , "Volume"            :-> Quantity
            , "Last"              :-> Quantity
            , "BaseVolume"        :-> Quantity
            , "TimeStamp"         :-> TimeStamp
            , "Bid"               :-> Quantity
            , "Ask"               :-> Quantity
            , "OpenBuyOrders"     :-> Word64
            , "OpenSellOrders"    :-> Word64
            , "PrevDay"           :-> Quantity
            , "Created"           :-> TimeStamp
            , "DisplayMarketName" :-> Null -- null?
            ]

--------------------------------------------------------------------------------

type OrderBook
  = Record '[ "buy"  :-> Vector BuyOrder
            , "sell" :-> Vector SellOrder
            ]

--------------------------------------------------------------------------------

type BuyOrder = Order

type SellOrder = Order

--------------------------------------------------------------------------------

data OrderBookType
  = OrderBookType_buy
  | OrderBookType_sell
  | OrderBookType_both

printOrderBookType :: OrderBookType -> Text
printOrderBookType OrderBookType_buy  = "buy"
printOrderBookType OrderBookType_sell = "sell"
printOrderBookType OrderBookType_both = "both"

parseOrderBookType :: Text -> Maybe OrderBookType
parseOrderBookType "buy"  = Just OrderBookType_buy
parseOrderBookType "sell" = Just OrderBookType_sell
parseOrderBookType "both" = Just OrderBookType_both
parseOrderBookType _      = Nothing

instance ParseJSON OrderBookType where
  parseJSON = do
    t <- AesonBE.asText
    let err = Text.pack ("OrderBookType: failed to parse: " <> show t)
              |> JSONParseError |> AesonBE.throwCustomError
    parseOrderBookType t |> maybe err pure

instance PrintJSON OrderBookType where
  printJSON = printOrderBookType .> printJSON

instance S.ToHttpApiData OrderBookType where
  toQueryParam = printOrderBookType

instance S.FromHttpApiData OrderBookType where
  parseQueryParam t
    = parseOrderBookType t
      |> maybe (Left ("OrderBookType: failed to parse: " <> t)) Right

--------------------------------------------------------------------------------

type Order
  = Record '[ "Quantity" :-> Quantity
            , "Rate"     :-> Quantity
            ]

--------------------------------------------------------------------------------

type Trade
  = Record '[ "Id"        :-> Word64
            , "TimeStamp" :-> TimeStamp
            , "Quantity"  :-> Quantity
            , "Price"     :-> Quantity
            , "Total"     :-> Quantity
            , "FillType"  :-> FillType
            , "OrderType" :-> OrderType
            ]

--------------------------------------------------------------------------------

data FillType
  = FillType_FILL
  | FillType_PARTIAL_FILL
  -- FIXME: are there more options?
  deriving ()

printFillType :: FillType -> Text
printFillType FillType_FILL         = "FILL"
printFillType FillType_PARTIAL_FILL = "PARTIAL_FILL"

parseFillType :: Text -> Maybe FillType
parseFillType "FILL"         = Just FillType_FILL
parseFillType "PARTIAL_FILL" = Just FillType_PARTIAL_FILL
parseFillType _              = Nothing

instance ParseJSON FillType where
  parseJSON = do
    t <- AesonBE.asText
    parseFillType t
      |> maybe (fail "FIXME: improve this error") pure

instance PrintJSON FillType where
  printJSON = printFillType .> Aeson.toJSON

--------------------------------------------------------------------------------

data OrderType
  = OrderType_BUY
  | OrderType_SELL
  | OrderType_LIMIT_BUY
  | OrderType_LIMIT_SELL
  -- FIXME: are there more options?
  deriving ()

printOrderType :: OrderType -> Text
printOrderType OrderType_BUY        = "BUY"
printOrderType OrderType_SELL       = "SELL"
printOrderType OrderType_LIMIT_BUY  = "LIMIT_BUY"
printOrderType OrderType_LIMIT_SELL = "LIMIT_SELL"

parseOrderType :: Text -> Maybe OrderType
parseOrderType "BUY"        = Just OrderType_BUY
parseOrderType "SELL"       = Just OrderType_SELL
parseOrderType "LIMIT_BUY"  = Just OrderType_LIMIT_BUY
parseOrderType "LIMIT_SELL" = Just OrderType_LIMIT_SELL
parseOrderType _            = Nothing

instance ParseJSON OrderType where
  parseJSON = do
    t <- AesonBE.asText
    parseOrderType t
      |> maybe (fail "FIXME: better error message") pure

instance PrintJSON OrderType where
  printJSON = printOrderType .> printJSON

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- MARKET API DATA TYPES -------------------------------------------------------
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

type OrderUUID
  = Record '[ "uuid" :-> UUID
            ]

--------------------------------------------------------------------------------

type OpenOrder
  = Record '[ "Uuid"              :-> (Maybe Aeson.Value)
            , "OrderUuid"         :-> UUID
            , "Exchange"          :-> MarketName
            , "OrderType"         :-> OrderType
            , "Quantity"          :-> Quantity
            , "QuantityRemaining" :-> Quantity
            , "Limit"             :-> Quantity
            , "CommissionPaid"    :-> Quantity
            , "Price"             :-> Quantity
            , "PricePerUnit"      :-> (Maybe Aeson.Value)
            , "Opened"            :-> TimeStamp
            , "Closed"            :-> (Maybe TimeStamp)
            , "CancelInitiated"   :-> Bool
            , "ImmediateOrCancel" :-> Bool
            , "IsConditional"     :-> Bool
            , "Condition"         :-> (Maybe Aeson.Value)
            , "ConditionTarget"   :-> (Maybe Aeson.Value)
            ]

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- ACCOUNT API DATA TYPES ------------------------------------------------------
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

type Balance
  = Record '[ "Currency" :-> SCurrencyName
            , "Balance" :-> Quantity
            , "Available" :-> Quantity
            , "Pending" :-> Quantity
            , "CryptoAddress" :-> Text
            , "Requested" :-> Bool
            , "Uuid" :-> (Maybe Aeson.Value)
            ]

--------------------------------------------------------------------------------

type DepositAddress
  = Record '[ "Currency" :-> SCurrencyName
            , "Address" :-> Text
            ]

--------------------------------------------------------------------------------

type WithdrawalUUID
  = Record '[ "uuid" :-> UUID
            ]

--------------------------------------------------------------------------------

type OrderDetail
  = Record '[ "AccountId"                  :-> (Maybe Aeson.Value)
            , "OrderUuid"                  :-> UUID
            , "Exchange"                   :-> MarketName
            , "Type"                       :-> OrderType
            , "Quantity"                   :-> Quantity
            , "QuantityRemaining"          :-> Quantity
            , "Limit"                      :-> Quantity
            , "Reserved"                   :-> Quantity
            , "ReserveRemaining"           :-> Quantity
            , "CommissionReserved"         :-> Quantity
            , "CommissionReserveRemaining" :-> Quantity
            , "CommissionPaid"             :-> Quantity
            , "Price"                      :-> Quantity
            , "PricePerUnit"               :-> (Maybe Aeson.Value)
            , "Opened"                     :-> TimeStamp
            , "Closed"                     :-> (Maybe TimeStamp)
            , "IsOpen"                     :-> Bool
            , "Sentinel"                   :-> UUID
            , "CancelInitiated"            :-> Bool
            , "ImmediateOrCancel"          :-> Bool
            , "IsConditional"              :-> Bool
            , "Condition"                  :-> (Maybe Aeson.Value)
            , "ConditionTarget"            :-> (Maybe Aeson.Value)
            ]

--------------------------------------------------------------------------------

type ClosedOrder
  = Record '[ "OrderUuid"         :-> UUID
            , "Exchange"          :-> MarketName
            , "TimeStamp"         :-> TimeStamp
            , "OrderType"         :-> OrderType
            , "Limit"             :-> Quantity
            , "Quantity"          :-> Quantity
            , "QuantityRemaining" :-> Quantity
            , "Commission"        :-> Quantity
            , "Price"             :-> Quantity
            , "PricePerUnit"      :-> (Maybe Aeson.Value)
            , "IsConditional"     :-> Bool
            , "Condition"         :-> (Maybe Aeson.Value)
            , "ConditionTarget"   :-> (Maybe Aeson.Value)
            , "ImmediateOrCancel" :-> Bool
            ]

--------------------------------------------------------------------------------

type Withdrawal
  = Record '[ "PaymentUuid" :-> UUID
            , "Currency" :-> SCurrencyName
            , "Amount" :-> Quantity
            , "Address" :-> Text
            , "Opened" :-> TimeStamp
            , "Authorized" :-> Bool
            , "PendingPayment" :-> Bool
            , "TxCost" :-> Quantity
            , "TxId" :-> (Maybe Text)
            , "Canceled" :-> Bool
            , "InvalidAddress" :-> Bool
            ]

--------------------------------------------------------------------------------


type Deposit
  = Record '[ "PaymentUuid"    :-> UUID
            , "Currency"       :-> SCurrencyName
            , "Amount"         :-> Quantity
            , "Address"        :-> Text
            , "Opened"         :-> TimeStamp
            , "Authorized"     :-> Bool
            , "PendingPayment" :-> Bool
            , "TxCost"         :-> Quantity
            , "TxId"           :-> (Maybe Text)
            , "Canceled"       :-> Bool
            , "InvalidAddress" :-> Bool
            ]

--------------------------------------------------------------------------------

instance ( Every Aeson.FromJSON u, Comp.RecordFromJson u
         ) => Aeson.FromJSON (Record u) where
  parseJSON = undefined

instance ( Every Aeson.ToJSON u, Comp.RecordToJsonObject u
         ) => Aeson.ToJSON (Record u) where
  toJSON = Comp.recordToJson encoder
    where
      encoder = undefined

--------------------------------------------------------------------------------

type family Every (c :: k -> Constraint) (xs :: [k]) :: Constraint where
  Every _ '[]        = ()
  Every c (x : rest) = (c x, Every c rest)

type family FieldTypes (f :: [Type]) where
  FieldTypes '[]                = '[]
  FieldTypes ((s :-> a) : rest) = a : FieldTypes rest
  FieldTypes (t         : rest) = TypeError
                                  ('Text "Not a field: " :<>: 'ShowType t)

--------------------------------------------------------------------------------

data JSONBE

instance S.Accept JSONBE where
  contentTypes _ = S.contentTypes (Proxy @S.JSON)

instance (ParseJSON t) => S.MimeUnrender JSONBE t where
  mimeUnrender = undefined

instance (PrintJSON t) => S.MimeRender JSONBE t where
  mimeRender = undefined

--------------------------------------------------------------------------------

class ParseJSON t where
  parseJSON :: AesonBE.Parse JSONParseError t

instance ParseJSON Aeson.Value where { parseJSON = AesonBE.asValue;      }
instance ParseJSON Text        where { parseJSON = AesonBE.asText;       }
instance ParseJSON String      where { parseJSON = AesonBE.asString;     }
instance ParseJSON Scientific  where { parseJSON = AesonBE.asScientific; }
instance ParseJSON Int         where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Int8        where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Int16       where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Int32       where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Int64       where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Word        where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Word8       where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Word16      where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Word32      where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Word64      where { parseJSON = AesonBE.asIntegral;   }
instance ParseJSON Bool        where { parseJSON = AesonBE.asBool;       }

-- FIXME: this instance is kind of evil because it collapses nested Maybes
instance (ParseJSON t) => ParseJSON (Maybe t) where
  parseJSON = AesonBE.perhaps parseJSON

instance (ParseJSON t) => ParseJSON [t] where
  parseJSON = AesonBE.eachInArray parseJSON

instance (ParseJSON t) => ParseJSON (Vector t) where
  parseJSON = Vector.fromList <$> parseJSON

instance ( Every ParseJSON (FieldTypes u)
         ) => ParseJSON (Record u) where
  parseJSON = undefined

instance ( Every PrintJSON (FieldTypes u)
         ) => PrintJSON (Record u) where
  printJSON = undefined

--------------------------------------------------------------------------------

class PrintJSON t where
  printJSON :: t -> Aeson.Value

instance (Aeson.ToJSON t) => PrintJSON t where
  printJSON = Aeson.toJSON

--------------------------------------------------------------------------------

data JSONParseError
  = JSONParseError Text
  deriving (Eq, Show, Generic)

instance Exception JSONParseError

--------------------------------------------------------------------------------