{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.Environment
    ( Environment (..)
    , WSConnection (..)

    , apiEndpoint
    , wsEndpoint
    ) where


import           Data.Text      (Text)
import           Network.Socket (HostName, PortNumber)


data Environment = Production | Sandbox


apiEndpoint :: Environment -> Text
apiEndpoint :: Environment -> Text
apiEndpoint Environment
Production = Text
productionAPIEndpoint
apiEndpoint Environment
Sandbox    = Text
sandboxAPIEndpoint


productionAPIEndpoint :: Text
productionAPIEndpoint :: Text
productionAPIEndpoint = Text
"api.pro.coinbase.com"


sandboxAPIEndpoint :: Text
sandboxAPIEndpoint :: Text
sandboxAPIEndpoint = Text
"api-public.sandbox.pro.coinbase.com"


data WSConnection = WSConnection
    { WSConnection -> HostName
host :: HostName
    , WSConnection -> PortNumber
port :: PortNumber
    } deriving (WSConnection -> WSConnection -> Bool
(WSConnection -> WSConnection -> Bool)
-> (WSConnection -> WSConnection -> Bool) -> Eq WSConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSConnection -> WSConnection -> Bool
$c/= :: WSConnection -> WSConnection -> Bool
== :: WSConnection -> WSConnection -> Bool
$c== :: WSConnection -> WSConnection -> Bool
Eq, Int -> WSConnection -> ShowS
[WSConnection] -> ShowS
WSConnection -> HostName
(Int -> WSConnection -> ShowS)
-> (WSConnection -> HostName)
-> ([WSConnection] -> ShowS)
-> Show WSConnection
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [WSConnection] -> ShowS
$cshowList :: [WSConnection] -> ShowS
show :: WSConnection -> HostName
$cshow :: WSConnection -> HostName
showsPrec :: Int -> WSConnection -> ShowS
$cshowsPrec :: Int -> WSConnection -> ShowS
Show)


wsEndpoint :: Environment -> WSConnection
wsEndpoint :: Environment -> WSConnection
wsEndpoint Environment
Production = WSConnection
productionWSEndpoint
wsEndpoint Environment
Sandbox    = WSConnection
sandboxWSEndpoint


productionWSEndpoint :: WSConnection
productionWSEndpoint :: WSConnection
productionWSEndpoint = HostName -> PortNumber -> WSConnection
WSConnection HostName
"ws-feed.pro.coinbase.com" PortNumber
443


sandboxWSEndpoint :: WSConnection
sandboxWSEndpoint :: WSConnection
sandboxWSEndpoint = HostName -> PortNumber -> WSConnection
WSConnection HostName
"ws-feed-public.sandbox.pro.coinbase.com" PortNumber
443