module ElectrsClient.Type
  ( RpcError (..),
    OnChainAddress (..),
    BlkHeight (..),
  )
where

import ElectrsClient.Import.External

data RpcError
  = RpcNoAddress
  | RpcJsonDecodeError
  | RpcHexDecodeError
  | CannotSyncBlockchain
  | OtherError Text
  deriving stock
    ( RpcError -> RpcError -> Bool
(RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> Bool) -> Eq RpcError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpcError -> RpcError -> Bool
$c/= :: RpcError -> RpcError -> Bool
== :: RpcError -> RpcError -> Bool
$c== :: RpcError -> RpcError -> Bool
Eq,
      (forall x. RpcError -> Rep RpcError x)
-> (forall x. Rep RpcError x -> RpcError) -> Generic RpcError
forall x. Rep RpcError x -> RpcError
forall x. RpcError -> Rep RpcError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RpcError x -> RpcError
$cfrom :: forall x. RpcError -> Rep RpcError x
Generic,
      Int -> RpcError -> ShowS
[RpcError] -> ShowS
RpcError -> String
(Int -> RpcError -> ShowS)
-> (RpcError -> String) -> ([RpcError] -> ShowS) -> Show RpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcError] -> ShowS
$cshowList :: [RpcError] -> ShowS
show :: RpcError -> String
$cshow :: RpcError -> String
showsPrec :: Int -> RpcError -> ShowS
$cshowsPrec :: Int -> RpcError -> ShowS
Show
    )

newtype OnChainAddress (mrel :: MoneyRelation)
  = OnChainAddress Text
  deriving newtype
    ( OnChainAddress mrel -> OnChainAddress mrel -> Bool
(OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> Eq (OnChainAddress mrel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
/= :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c/= :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
== :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c== :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
Eq,
      Eq (OnChainAddress mrel)
Eq (OnChainAddress mrel)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Ordering)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> (OnChainAddress mrel -> OnChainAddress mrel -> Bool)
-> (OnChainAddress mrel
    -> OnChainAddress mrel -> OnChainAddress mrel)
-> (OnChainAddress mrel
    -> OnChainAddress mrel -> OnChainAddress mrel)
-> Ord (OnChainAddress mrel)
OnChainAddress mrel -> OnChainAddress mrel -> Bool
OnChainAddress mrel -> OnChainAddress mrel -> Ordering
OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (mrel :: MoneyRelation). Eq (OnChainAddress mrel)
forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Ordering
forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
min :: OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
$cmin :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
max :: OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
$cmax :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> OnChainAddress mrel
>= :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c>= :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
> :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c> :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
<= :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c<= :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
< :: OnChainAddress mrel -> OnChainAddress mrel -> Bool
$c< :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Bool
compare :: OnChainAddress mrel -> OnChainAddress mrel -> Ordering
$ccompare :: forall (mrel :: MoneyRelation).
OnChainAddress mrel -> OnChainAddress mrel -> Ordering
Ord,
      Int -> OnChainAddress mrel -> ShowS
[OnChainAddress mrel] -> ShowS
OnChainAddress mrel -> String
(Int -> OnChainAddress mrel -> ShowS)
-> (OnChainAddress mrel -> String)
-> ([OnChainAddress mrel] -> ShowS)
-> Show (OnChainAddress mrel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mrel :: MoneyRelation). Int -> OnChainAddress mrel -> ShowS
forall (mrel :: MoneyRelation). [OnChainAddress mrel] -> ShowS
forall (mrel :: MoneyRelation). OnChainAddress mrel -> String
showList :: [OnChainAddress mrel] -> ShowS
$cshowList :: forall (mrel :: MoneyRelation). [OnChainAddress mrel] -> ShowS
show :: OnChainAddress mrel -> String
$cshow :: forall (mrel :: MoneyRelation). OnChainAddress mrel -> String
showsPrec :: Int -> OnChainAddress mrel -> ShowS
$cshowsPrec :: forall (mrel :: MoneyRelation). Int -> OnChainAddress mrel -> ShowS
Show,
      ReadPrec [OnChainAddress mrel]
ReadPrec (OnChainAddress mrel)
Int -> ReadS (OnChainAddress mrel)
ReadS [OnChainAddress mrel]
(Int -> ReadS (OnChainAddress mrel))
-> ReadS [OnChainAddress mrel]
-> ReadPrec (OnChainAddress mrel)
-> ReadPrec [OnChainAddress mrel]
-> Read (OnChainAddress mrel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (mrel :: MoneyRelation). ReadPrec [OnChainAddress mrel]
forall (mrel :: MoneyRelation). ReadPrec (OnChainAddress mrel)
forall (mrel :: MoneyRelation). Int -> ReadS (OnChainAddress mrel)
forall (mrel :: MoneyRelation). ReadS [OnChainAddress mrel]
readListPrec :: ReadPrec [OnChainAddress mrel]
$creadListPrec :: forall (mrel :: MoneyRelation). ReadPrec [OnChainAddress mrel]
readPrec :: ReadPrec (OnChainAddress mrel)
$creadPrec :: forall (mrel :: MoneyRelation). ReadPrec (OnChainAddress mrel)
readList :: ReadS [OnChainAddress mrel]
$creadList :: forall (mrel :: MoneyRelation). ReadS [OnChainAddress mrel]
readsPrec :: Int -> ReadS (OnChainAddress mrel)
$creadsPrec :: forall (mrel :: MoneyRelation). Int -> ReadS (OnChainAddress mrel)
Read
    )
  deriving stock
    ( (forall x. OnChainAddress mrel -> Rep (OnChainAddress mrel) x)
-> (forall x. Rep (OnChainAddress mrel) x -> OnChainAddress mrel)
-> Generic (OnChainAddress mrel)
forall x. Rep (OnChainAddress mrel) x -> OnChainAddress mrel
forall x. OnChainAddress mrel -> Rep (OnChainAddress mrel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mrel :: MoneyRelation) x.
Rep (OnChainAddress mrel) x -> OnChainAddress mrel
forall (mrel :: MoneyRelation) x.
OnChainAddress mrel -> Rep (OnChainAddress mrel) x
$cto :: forall (mrel :: MoneyRelation) x.
Rep (OnChainAddress mrel) x -> OnChainAddress mrel
$cfrom :: forall (mrel :: MoneyRelation) x.
OnChainAddress mrel -> Rep (OnChainAddress mrel) x
Generic
    )

data MoneyRelation
  = Fund
  | Refund
  | Gain
  | Loss
  deriving stock
    ( MoneyRelation -> MoneyRelation -> Bool
(MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool) -> Eq MoneyRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoneyRelation -> MoneyRelation -> Bool
$c/= :: MoneyRelation -> MoneyRelation -> Bool
== :: MoneyRelation -> MoneyRelation -> Bool
$c== :: MoneyRelation -> MoneyRelation -> Bool
Eq,
      Eq MoneyRelation
Eq MoneyRelation
-> (MoneyRelation -> MoneyRelation -> Ordering)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> Bool)
-> (MoneyRelation -> MoneyRelation -> MoneyRelation)
-> (MoneyRelation -> MoneyRelation -> MoneyRelation)
-> Ord MoneyRelation
MoneyRelation -> MoneyRelation -> Bool
MoneyRelation -> MoneyRelation -> Ordering
MoneyRelation -> MoneyRelation -> MoneyRelation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MoneyRelation -> MoneyRelation -> MoneyRelation
$cmin :: MoneyRelation -> MoneyRelation -> MoneyRelation
max :: MoneyRelation -> MoneyRelation -> MoneyRelation
$cmax :: MoneyRelation -> MoneyRelation -> MoneyRelation
>= :: MoneyRelation -> MoneyRelation -> Bool
$c>= :: MoneyRelation -> MoneyRelation -> Bool
> :: MoneyRelation -> MoneyRelation -> Bool
$c> :: MoneyRelation -> MoneyRelation -> Bool
<= :: MoneyRelation -> MoneyRelation -> Bool
$c<= :: MoneyRelation -> MoneyRelation -> Bool
< :: MoneyRelation -> MoneyRelation -> Bool
$c< :: MoneyRelation -> MoneyRelation -> Bool
compare :: MoneyRelation -> MoneyRelation -> Ordering
$ccompare :: MoneyRelation -> MoneyRelation -> Ordering
Ord,
      Int -> MoneyRelation -> ShowS
[MoneyRelation] -> ShowS
MoneyRelation -> String
(Int -> MoneyRelation -> ShowS)
-> (MoneyRelation -> String)
-> ([MoneyRelation] -> ShowS)
-> Show MoneyRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoneyRelation] -> ShowS
$cshowList :: [MoneyRelation] -> ShowS
show :: MoneyRelation -> String
$cshow :: MoneyRelation -> String
showsPrec :: Int -> MoneyRelation -> ShowS
$cshowsPrec :: Int -> MoneyRelation -> ShowS
Show,
      (forall x. MoneyRelation -> Rep MoneyRelation x)
-> (forall x. Rep MoneyRelation x -> MoneyRelation)
-> Generic MoneyRelation
forall x. Rep MoneyRelation x -> MoneyRelation
forall x. MoneyRelation -> Rep MoneyRelation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MoneyRelation x -> MoneyRelation
$cfrom :: forall x. MoneyRelation -> Rep MoneyRelation x
Generic
    )

newtype BlkHeight
  = BlkHeight Word64
  deriving stock
    ( BlkHeight -> BlkHeight -> Bool
(BlkHeight -> BlkHeight -> Bool)
-> (BlkHeight -> BlkHeight -> Bool) -> Eq BlkHeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlkHeight -> BlkHeight -> Bool
$c/= :: BlkHeight -> BlkHeight -> Bool
== :: BlkHeight -> BlkHeight -> Bool
$c== :: BlkHeight -> BlkHeight -> Bool
Eq,
      Eq BlkHeight
Eq BlkHeight
-> (BlkHeight -> BlkHeight -> Ordering)
-> (BlkHeight -> BlkHeight -> Bool)
-> (BlkHeight -> BlkHeight -> Bool)
-> (BlkHeight -> BlkHeight -> Bool)
-> (BlkHeight -> BlkHeight -> Bool)
-> (BlkHeight -> BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight -> BlkHeight)
-> Ord BlkHeight
BlkHeight -> BlkHeight -> Bool
BlkHeight -> BlkHeight -> Ordering
BlkHeight -> BlkHeight -> BlkHeight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlkHeight -> BlkHeight -> BlkHeight
$cmin :: BlkHeight -> BlkHeight -> BlkHeight
max :: BlkHeight -> BlkHeight -> BlkHeight
$cmax :: BlkHeight -> BlkHeight -> BlkHeight
>= :: BlkHeight -> BlkHeight -> Bool
$c>= :: BlkHeight -> BlkHeight -> Bool
> :: BlkHeight -> BlkHeight -> Bool
$c> :: BlkHeight -> BlkHeight -> Bool
<= :: BlkHeight -> BlkHeight -> Bool
$c<= :: BlkHeight -> BlkHeight -> Bool
< :: BlkHeight -> BlkHeight -> Bool
$c< :: BlkHeight -> BlkHeight -> Bool
compare :: BlkHeight -> BlkHeight -> Ordering
$ccompare :: BlkHeight -> BlkHeight -> Ordering
Ord,
      Int -> BlkHeight -> ShowS
[BlkHeight] -> ShowS
BlkHeight -> String
(Int -> BlkHeight -> ShowS)
-> (BlkHeight -> String)
-> ([BlkHeight] -> ShowS)
-> Show BlkHeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlkHeight] -> ShowS
$cshowList :: [BlkHeight] -> ShowS
show :: BlkHeight -> String
$cshow :: BlkHeight -> String
showsPrec :: Int -> BlkHeight -> ShowS
$cshowsPrec :: Int -> BlkHeight -> ShowS
Show,
      (forall x. BlkHeight -> Rep BlkHeight x)
-> (forall x. Rep BlkHeight x -> BlkHeight) -> Generic BlkHeight
forall x. Rep BlkHeight x -> BlkHeight
forall x. BlkHeight -> Rep BlkHeight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlkHeight x -> BlkHeight
$cfrom :: forall x. BlkHeight -> Rep BlkHeight x
Generic
    )
  deriving newtype
    ( Integer -> BlkHeight
BlkHeight -> BlkHeight
BlkHeight -> BlkHeight -> BlkHeight
(BlkHeight -> BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight)
-> (BlkHeight -> BlkHeight)
-> (Integer -> BlkHeight)
-> Num BlkHeight
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BlkHeight
$cfromInteger :: Integer -> BlkHeight
signum :: BlkHeight -> BlkHeight
$csignum :: BlkHeight -> BlkHeight
abs :: BlkHeight -> BlkHeight
$cabs :: BlkHeight -> BlkHeight
negate :: BlkHeight -> BlkHeight
$cnegate :: BlkHeight -> BlkHeight
* :: BlkHeight -> BlkHeight -> BlkHeight
$c* :: BlkHeight -> BlkHeight -> BlkHeight
- :: BlkHeight -> BlkHeight -> BlkHeight
$c- :: BlkHeight -> BlkHeight -> BlkHeight
+ :: BlkHeight -> BlkHeight -> BlkHeight
$c+ :: BlkHeight -> BlkHeight -> BlkHeight
Num,
      [BlkHeight] -> Encoding
[BlkHeight] -> Value
BlkHeight -> Encoding
BlkHeight -> Value
(BlkHeight -> Value)
-> (BlkHeight -> Encoding)
-> ([BlkHeight] -> Value)
-> ([BlkHeight] -> Encoding)
-> ToJSON BlkHeight
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BlkHeight] -> Encoding
$ctoEncodingList :: [BlkHeight] -> Encoding
toJSONList :: [BlkHeight] -> Value
$ctoJSONList :: [BlkHeight] -> Value
toEncoding :: BlkHeight -> Encoding
$ctoEncoding :: BlkHeight -> Encoding
toJSON :: BlkHeight -> Value
$ctoJSON :: BlkHeight -> Value
ToJSON
    )