{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module BtcLsp.Data.Type
  ( Nonce,
    newNonce,
    LnInvoice (..),
    LnInvoiceStatus (..),
    LnChanStatus (..),
    Liquidity (..),
    Money (..),
    FeeRate (..),
    UnsafeOnChainAddress (..),
    Seconds (..),
    LogFormat (..),
    YesodLog (..),
    MicroSeconds (..),
    SwapStatus (..),
    swapStatusChain,
    swapStatusLn,
    swapStatusFinal,
    Failure (..),
    FailureInternal (..),
    FailureInput (..),
    tryFailureE,
    tryFailureT,
    tryFromE,
    tryFromT,
    SocketAddress (..),
    BlkHash (..),
    BlkHeight (..),
    BlkStatus (..),
    SwapUtxoStatus (..),
    Privacy (..),
    NodePubKeyHex (..),
    NodeUri (..),
    NodeUriHex (..),
    UtxoLockId (..),
    RHashHex (..),
    Uuid,
    unUuid,
    newUuid,
    Vbyte (..),
    RowQty (..),
    PsbtUtxo (..),
    SwapHash (..),
  )
where

import BtcLsp.Data.Kind
import BtcLsp.Data.Orphan ()
import BtcLsp.Import.External
import qualified BtcLsp.Import.Psql as Psql
import qualified BtcLsp.Text as T
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Time.Clock as Clock
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import qualified LndClient as Lnd
import qualified LndClient.Data.OutPoint as OP
import qualified Network.Bitcoin.BlockChain as Btc
import Text.Julius (ToJavascript)
import qualified Universum
import qualified Witch
import Yesod.Core

newtype Nonce
  = Nonce Word64
  deriving newtype
    ( Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c== :: Nonce -> Nonce -> Bool
Eq,
      Eq Nonce
Eq Nonce
-> (Nonce -> Nonce -> Ordering)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Bool)
-> (Nonce -> Nonce -> Nonce)
-> (Nonce -> Nonce -> Nonce)
-> Ord Nonce
Nonce -> Nonce -> Bool
Nonce -> Nonce -> Ordering
Nonce -> Nonce -> Nonce
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 :: Nonce -> Nonce -> Nonce
$cmin :: Nonce -> Nonce -> Nonce
max :: Nonce -> Nonce -> Nonce
$cmax :: Nonce -> Nonce -> Nonce
>= :: Nonce -> Nonce -> Bool
$c>= :: Nonce -> Nonce -> Bool
> :: Nonce -> Nonce -> Bool
$c> :: Nonce -> Nonce -> Bool
<= :: Nonce -> Nonce -> Bool
$c<= :: Nonce -> Nonce -> Bool
< :: Nonce -> Nonce -> Bool
$c< :: Nonce -> Nonce -> Bool
compare :: Nonce -> Nonce -> Ordering
$ccompare :: Nonce -> Nonce -> Ordering
Ord,
      Int -> Nonce -> ShowS
[Nonce] -> ShowS
Nonce -> HostName
(Int -> Nonce -> ShowS)
-> (Nonce -> HostName) -> ([Nonce] -> ShowS) -> Show Nonce
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Nonce] -> ShowS
$cshowList :: [Nonce] -> ShowS
show :: Nonce -> HostName
$cshow :: Nonce -> HostName
showsPrec :: Int -> Nonce -> ShowS
$cshowsPrec :: Int -> Nonce -> ShowS
Show,
      ReadPrec [Nonce]
ReadPrec Nonce
Int -> ReadS Nonce
ReadS [Nonce]
(Int -> ReadS Nonce)
-> ReadS [Nonce]
-> ReadPrec Nonce
-> ReadPrec [Nonce]
-> Read Nonce
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Nonce]
$creadListPrec :: ReadPrec [Nonce]
readPrec :: ReadPrec Nonce
$creadPrec :: ReadPrec Nonce
readList :: ReadS [Nonce]
$creadList :: ReadS [Nonce]
readsPrec :: Int -> ReadS Nonce
$creadsPrec :: Int -> ReadS Nonce
Read,
      PersistValue -> Either Text Nonce
Nonce -> PersistValue
(Nonce -> PersistValue)
-> (PersistValue -> Either Text Nonce) -> PersistField Nonce
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text Nonce
$cfromPersistValue :: PersistValue -> Either Text Nonce
toPersistValue :: Nonce -> PersistValue
$ctoPersistValue :: Nonce -> PersistValue
Psql.PersistField,
      PersistField Nonce
Proxy Nonce -> SqlType
PersistField Nonce
-> (Proxy Nonce -> SqlType) -> PersistFieldSql Nonce
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy Nonce -> SqlType
$csqlType :: Proxy Nonce -> SqlType
Psql.PersistFieldSql
    )
  deriving stock
    ( (forall x. Nonce -> Rep Nonce x)
-> (forall x. Rep Nonce x -> Nonce) -> Generic Nonce
forall x. Rep Nonce x -> Nonce
forall x. Nonce -> Rep Nonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nonce x -> Nonce
$cfrom :: forall x. Nonce -> Rep Nonce x
Generic
    )

instance Out Nonce

instance From Nonce Word64

instance From Word64 Nonce

newNonce :: (MonadIO m) => m Nonce
newNonce :: forall (m :: * -> *). MonadIO m => m Nonce
newNonce =
  IO Nonce -> m Nonce
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Nonce -> m Nonce) -> IO Nonce -> m Nonce
forall a b. (a -> b) -> a -> b
$
    Word64 -> Nonce
Nonce
      (Word64 -> Nonce) -> (UTCTime -> Word64) -> UTCTime -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Word64
utcTimeToMicros
      (UTCTime -> Nonce) -> IO UTCTime -> IO Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
Clock.getCurrentTime

utcTimeToMicros :: UTCTime -> Word64
utcTimeToMicros :: UTCTime -> Word64
utcTimeToMicros UTCTime
x =
  Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$
    DiffTime -> Integer
diffTimeToPicoseconds
      ( Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational
          (Rational -> DiffTime)
-> (POSIXTime -> Rational) -> POSIXTime -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational
          (POSIXTime -> DiffTime) -> POSIXTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> POSIXTime
diffUTCTime UTCTime
x UTCTime
epoch
      )
      Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000

epoch :: UTCTime
epoch :: UTCTime
epoch =
  POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0

data LogFormat
  = Bracket
  | JSON
  deriving stock
    ( ReadPrec [LogFormat]
ReadPrec LogFormat
Int -> ReadS LogFormat
ReadS [LogFormat]
(Int -> ReadS LogFormat)
-> ReadS [LogFormat]
-> ReadPrec LogFormat
-> ReadPrec [LogFormat]
-> Read LogFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogFormat]
$creadListPrec :: ReadPrec [LogFormat]
readPrec :: ReadPrec LogFormat
$creadPrec :: ReadPrec LogFormat
readList :: ReadS [LogFormat]
$creadList :: ReadS [LogFormat]
readsPrec :: Int -> ReadS LogFormat
$creadsPrec :: Int -> ReadS LogFormat
Read
    )

data YesodLog
  = YesodLogAll
  | YesodLogNoMain
  | YesodLogNothing
  deriving stock
    ( YesodLog -> YesodLog -> Bool
(YesodLog -> YesodLog -> Bool)
-> (YesodLog -> YesodLog -> Bool) -> Eq YesodLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YesodLog -> YesodLog -> Bool
$c/= :: YesodLog -> YesodLog -> Bool
== :: YesodLog -> YesodLog -> Bool
$c== :: YesodLog -> YesodLog -> Bool
Eq,
      Eq YesodLog
Eq YesodLog
-> (YesodLog -> YesodLog -> Ordering)
-> (YesodLog -> YesodLog -> Bool)
-> (YesodLog -> YesodLog -> Bool)
-> (YesodLog -> YesodLog -> Bool)
-> (YesodLog -> YesodLog -> Bool)
-> (YesodLog -> YesodLog -> YesodLog)
-> (YesodLog -> YesodLog -> YesodLog)
-> Ord YesodLog
YesodLog -> YesodLog -> Bool
YesodLog -> YesodLog -> Ordering
YesodLog -> YesodLog -> YesodLog
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 :: YesodLog -> YesodLog -> YesodLog
$cmin :: YesodLog -> YesodLog -> YesodLog
max :: YesodLog -> YesodLog -> YesodLog
$cmax :: YesodLog -> YesodLog -> YesodLog
>= :: YesodLog -> YesodLog -> Bool
$c>= :: YesodLog -> YesodLog -> Bool
> :: YesodLog -> YesodLog -> Bool
$c> :: YesodLog -> YesodLog -> Bool
<= :: YesodLog -> YesodLog -> Bool
$c<= :: YesodLog -> YesodLog -> Bool
< :: YesodLog -> YesodLog -> Bool
$c< :: YesodLog -> YesodLog -> Bool
compare :: YesodLog -> YesodLog -> Ordering
$ccompare :: YesodLog -> YesodLog -> Ordering
Ord,
      Int -> YesodLog -> ShowS
[YesodLog] -> ShowS
YesodLog -> HostName
(Int -> YesodLog -> ShowS)
-> (YesodLog -> HostName) -> ([YesodLog] -> ShowS) -> Show YesodLog
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [YesodLog] -> ShowS
$cshowList :: [YesodLog] -> ShowS
show :: YesodLog -> HostName
$cshow :: YesodLog -> HostName
showsPrec :: Int -> YesodLog -> ShowS
$cshowsPrec :: Int -> YesodLog -> ShowS
Show,
      ReadPrec [YesodLog]
ReadPrec YesodLog
Int -> ReadS YesodLog
ReadS [YesodLog]
(Int -> ReadS YesodLog)
-> ReadS [YesodLog]
-> ReadPrec YesodLog
-> ReadPrec [YesodLog]
-> Read YesodLog
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [YesodLog]
$creadListPrec :: ReadPrec [YesodLog]
readPrec :: ReadPrec YesodLog
$creadPrec :: ReadPrec YesodLog
readList :: ReadS [YesodLog]
$creadList :: ReadS [YesodLog]
readsPrec :: Int -> ReadS YesodLog
$creadsPrec :: Int -> ReadS YesodLog
Read,
      (forall x. YesodLog -> Rep YesodLog x)
-> (forall x. Rep YesodLog x -> YesodLog) -> Generic YesodLog
forall x. Rep YesodLog x -> YesodLog
forall x. YesodLog -> Rep YesodLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep YesodLog x -> YesodLog
$cfrom :: forall x. YesodLog -> Rep YesodLog x
Generic
    )

instance FromJSON YesodLog

newtype Seconds
  = Seconds Word64
  deriving newtype
    ( Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq,
      Eq Seconds
Eq Seconds
-> (Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
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 :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
Ord,
      Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> HostName
(Int -> Seconds -> ShowS)
-> (Seconds -> HostName) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> HostName
$cshow :: Seconds -> HostName
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show,
      Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num
    )
  deriving stock
    ( (forall x. Seconds -> Rep Seconds x)
-> (forall x. Rep Seconds x -> Seconds) -> Generic Seconds
forall x. Rep Seconds x -> Seconds
forall x. Seconds -> Rep Seconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Seconds x -> Seconds
$cfrom :: forall x. Seconds -> Rep Seconds x
Generic
    )

instance Out Seconds

newtype MicroSeconds
  = MicroSeconds Integer
  deriving newtype
    ( MicroSeconds -> MicroSeconds -> Bool
(MicroSeconds -> MicroSeconds -> Bool)
-> (MicroSeconds -> MicroSeconds -> Bool) -> Eq MicroSeconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MicroSeconds -> MicroSeconds -> Bool
$c/= :: MicroSeconds -> MicroSeconds -> Bool
== :: MicroSeconds -> MicroSeconds -> Bool
$c== :: MicroSeconds -> MicroSeconds -> Bool
Eq,
      Eq MicroSeconds
Eq MicroSeconds
-> (MicroSeconds -> MicroSeconds -> Ordering)
-> (MicroSeconds -> MicroSeconds -> Bool)
-> (MicroSeconds -> MicroSeconds -> Bool)
-> (MicroSeconds -> MicroSeconds -> Bool)
-> (MicroSeconds -> MicroSeconds -> Bool)
-> (MicroSeconds -> MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds -> MicroSeconds)
-> Ord MicroSeconds
MicroSeconds -> MicroSeconds -> Bool
MicroSeconds -> MicroSeconds -> Ordering
MicroSeconds -> MicroSeconds -> MicroSeconds
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 :: MicroSeconds -> MicroSeconds -> MicroSeconds
$cmin :: MicroSeconds -> MicroSeconds -> MicroSeconds
max :: MicroSeconds -> MicroSeconds -> MicroSeconds
$cmax :: MicroSeconds -> MicroSeconds -> MicroSeconds
>= :: MicroSeconds -> MicroSeconds -> Bool
$c>= :: MicroSeconds -> MicroSeconds -> Bool
> :: MicroSeconds -> MicroSeconds -> Bool
$c> :: MicroSeconds -> MicroSeconds -> Bool
<= :: MicroSeconds -> MicroSeconds -> Bool
$c<= :: MicroSeconds -> MicroSeconds -> Bool
< :: MicroSeconds -> MicroSeconds -> Bool
$c< :: MicroSeconds -> MicroSeconds -> Bool
compare :: MicroSeconds -> MicroSeconds -> Ordering
$ccompare :: MicroSeconds -> MicroSeconds -> Ordering
Ord,
      Int -> MicroSeconds -> ShowS
[MicroSeconds] -> ShowS
MicroSeconds -> HostName
(Int -> MicroSeconds -> ShowS)
-> (MicroSeconds -> HostName)
-> ([MicroSeconds] -> ShowS)
-> Show MicroSeconds
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [MicroSeconds] -> ShowS
$cshowList :: [MicroSeconds] -> ShowS
show :: MicroSeconds -> HostName
$cshow :: MicroSeconds -> HostName
showsPrec :: Int -> MicroSeconds -> ShowS
$cshowsPrec :: Int -> MicroSeconds -> ShowS
Show,
      Integer -> MicroSeconds
MicroSeconds -> MicroSeconds
MicroSeconds -> MicroSeconds -> MicroSeconds
(MicroSeconds -> MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds)
-> (MicroSeconds -> MicroSeconds)
-> (Integer -> MicroSeconds)
-> Num MicroSeconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MicroSeconds
$cfromInteger :: Integer -> MicroSeconds
signum :: MicroSeconds -> MicroSeconds
$csignum :: MicroSeconds -> MicroSeconds
abs :: MicroSeconds -> MicroSeconds
$cabs :: MicroSeconds -> MicroSeconds
negate :: MicroSeconds -> MicroSeconds
$cnegate :: MicroSeconds -> MicroSeconds
* :: MicroSeconds -> MicroSeconds -> MicroSeconds
$c* :: MicroSeconds -> MicroSeconds -> MicroSeconds
- :: MicroSeconds -> MicroSeconds -> MicroSeconds
$c- :: MicroSeconds -> MicroSeconds -> MicroSeconds
+ :: MicroSeconds -> MicroSeconds -> MicroSeconds
$c+ :: MicroSeconds -> MicroSeconds -> MicroSeconds
Num
    )
  deriving stock
    ( (forall x. MicroSeconds -> Rep MicroSeconds x)
-> (forall x. Rep MicroSeconds x -> MicroSeconds)
-> Generic MicroSeconds
forall x. Rep MicroSeconds x -> MicroSeconds
forall x. MicroSeconds -> Rep MicroSeconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MicroSeconds x -> MicroSeconds
$cfrom :: forall x. MicroSeconds -> Rep MicroSeconds x
Generic
    )

instance Out MicroSeconds

newtype LnInvoice (mrel :: MoneyRelation)
  = LnInvoice Lnd.PaymentRequest
  deriving newtype
    ( LnInvoice mrel -> LnInvoice mrel -> Bool
(LnInvoice mrel -> LnInvoice mrel -> Bool)
-> (LnInvoice mrel -> LnInvoice mrel -> Bool)
-> Eq (LnInvoice mrel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mrel :: MoneyRelation).
LnInvoice mrel -> LnInvoice mrel -> Bool
/= :: LnInvoice mrel -> LnInvoice mrel -> Bool
$c/= :: forall (mrel :: MoneyRelation).
LnInvoice mrel -> LnInvoice mrel -> Bool
== :: LnInvoice mrel -> LnInvoice mrel -> Bool
$c== :: forall (mrel :: MoneyRelation).
LnInvoice mrel -> LnInvoice mrel -> Bool
Eq,
      Int -> LnInvoice mrel -> ShowS
[LnInvoice mrel] -> ShowS
LnInvoice mrel -> HostName
(Int -> LnInvoice mrel -> ShowS)
-> (LnInvoice mrel -> HostName)
-> ([LnInvoice mrel] -> ShowS)
-> Show (LnInvoice mrel)
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
forall (mrel :: MoneyRelation). Int -> LnInvoice mrel -> ShowS
forall (mrel :: MoneyRelation). [LnInvoice mrel] -> ShowS
forall (mrel :: MoneyRelation). LnInvoice mrel -> HostName
showList :: [LnInvoice mrel] -> ShowS
$cshowList :: forall (mrel :: MoneyRelation). [LnInvoice mrel] -> ShowS
show :: LnInvoice mrel -> HostName
$cshow :: forall (mrel :: MoneyRelation). LnInvoice mrel -> HostName
showsPrec :: Int -> LnInvoice mrel -> ShowS
$cshowsPrec :: forall (mrel :: MoneyRelation). Int -> LnInvoice mrel -> ShowS
Show,
      PersistValue -> Either Text (LnInvoice mrel)
LnInvoice mrel -> PersistValue
(LnInvoice mrel -> PersistValue)
-> (PersistValue -> Either Text (LnInvoice mrel))
-> PersistField (LnInvoice mrel)
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
forall (mrel :: MoneyRelation).
PersistValue -> Either Text (LnInvoice mrel)
forall (mrel :: MoneyRelation). LnInvoice mrel -> PersistValue
fromPersistValue :: PersistValue -> Either Text (LnInvoice mrel)
$cfromPersistValue :: forall (mrel :: MoneyRelation).
PersistValue -> Either Text (LnInvoice mrel)
toPersistValue :: LnInvoice mrel -> PersistValue
$ctoPersistValue :: forall (mrel :: MoneyRelation). LnInvoice mrel -> PersistValue
Psql.PersistField,
      PersistField (LnInvoice mrel)
Proxy (LnInvoice mrel) -> SqlType
PersistField (LnInvoice mrel)
-> (Proxy (LnInvoice mrel) -> SqlType)
-> PersistFieldSql (LnInvoice mrel)
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
forall (mrel :: MoneyRelation). PersistField (LnInvoice mrel)
forall (mrel :: MoneyRelation). Proxy (LnInvoice mrel) -> SqlType
sqlType :: Proxy (LnInvoice mrel) -> SqlType
$csqlType :: forall (mrel :: MoneyRelation). Proxy (LnInvoice mrel) -> SqlType
Psql.PersistFieldSql,
      Text -> Maybe (LnInvoice mrel)
LnInvoice mrel -> Text
(Text -> Maybe (LnInvoice mrel))
-> (LnInvoice mrel -> Text) -> PathPiece (LnInvoice mrel)
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
forall (mrel :: MoneyRelation). Text -> Maybe (LnInvoice mrel)
forall (mrel :: MoneyRelation). LnInvoice mrel -> Text
toPathPiece :: LnInvoice mrel -> Text
$ctoPathPiece :: forall (mrel :: MoneyRelation). LnInvoice mrel -> Text
fromPathPiece :: Text -> Maybe (LnInvoice mrel)
$cfromPathPiece :: forall (mrel :: MoneyRelation). Text -> Maybe (LnInvoice mrel)
PathPiece
    )
  deriving stock
    ( (forall x. LnInvoice mrel -> Rep (LnInvoice mrel) x)
-> (forall x. Rep (LnInvoice mrel) x -> LnInvoice mrel)
-> Generic (LnInvoice mrel)
forall x. Rep (LnInvoice mrel) x -> LnInvoice mrel
forall x. LnInvoice mrel -> Rep (LnInvoice mrel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mrel :: MoneyRelation) x.
Rep (LnInvoice mrel) x -> LnInvoice mrel
forall (mrel :: MoneyRelation) x.
LnInvoice mrel -> Rep (LnInvoice mrel) x
$cto :: forall (mrel :: MoneyRelation) x.
Rep (LnInvoice mrel) x -> LnInvoice mrel
$cfrom :: forall (mrel :: MoneyRelation) x.
LnInvoice mrel -> Rep (LnInvoice mrel) x
Generic
    )

instance Out (LnInvoice mrel)

instance From Lnd.PaymentRequest (LnInvoice mrel)

instance From (LnInvoice mrel) Lnd.PaymentRequest

instance From Text (LnInvoice mrel) where
  from :: Text -> LnInvoice mrel
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Lnd.PaymentRequest

instance From (LnInvoice mrel) Text where
  from :: LnInvoice mrel -> Text
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Lnd.PaymentRequest

newtype SwapHash = SwapHash Text
  deriving newtype
    ( SwapHash -> SwapHash -> Bool
(SwapHash -> SwapHash -> Bool)
-> (SwapHash -> SwapHash -> Bool) -> Eq SwapHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapHash -> SwapHash -> Bool
$c/= :: SwapHash -> SwapHash -> Bool
== :: SwapHash -> SwapHash -> Bool
$c== :: SwapHash -> SwapHash -> Bool
Eq,
      Int -> SwapHash -> ShowS
[SwapHash] -> ShowS
SwapHash -> HostName
(Int -> SwapHash -> ShowS)
-> (SwapHash -> HostName) -> ([SwapHash] -> ShowS) -> Show SwapHash
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SwapHash] -> ShowS
$cshowList :: [SwapHash] -> ShowS
show :: SwapHash -> HostName
$cshow :: SwapHash -> HostName
showsPrec :: Int -> SwapHash -> ShowS
$cshowsPrec :: Int -> SwapHash -> ShowS
Show,
      ReadPrec [SwapHash]
ReadPrec SwapHash
Int -> ReadS SwapHash
ReadS [SwapHash]
(Int -> ReadS SwapHash)
-> ReadS [SwapHash]
-> ReadPrec SwapHash
-> ReadPrec [SwapHash]
-> Read SwapHash
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapHash]
$creadListPrec :: ReadPrec [SwapHash]
readPrec :: ReadPrec SwapHash
$creadPrec :: ReadPrec SwapHash
readList :: ReadS [SwapHash]
$creadList :: ReadS [SwapHash]
readsPrec :: Int -> ReadS SwapHash
$creadsPrec :: Int -> ReadS SwapHash
Read,
      Text -> Maybe SwapHash
SwapHash -> Text
(Text -> Maybe SwapHash)
-> (SwapHash -> Text) -> PathPiece SwapHash
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
toPathPiece :: SwapHash -> Text
$ctoPathPiece :: SwapHash -> Text
fromPathPiece :: Text -> Maybe SwapHash
$cfromPathPiece :: Text -> Maybe SwapHash
PathPiece,
      SwapHash -> Javascript
(SwapHash -> Javascript) -> ToJavascript SwapHash
forall a. (a -> Javascript) -> ToJavascript a
toJavascript :: SwapHash -> Javascript
$ctoJavascript :: SwapHash -> Javascript
ToJavascript,
      [SwapHash] -> Encoding
[SwapHash] -> Value
SwapHash -> Encoding
SwapHash -> Value
(SwapHash -> Value)
-> (SwapHash -> Encoding)
-> ([SwapHash] -> Value)
-> ([SwapHash] -> Encoding)
-> ToJSON SwapHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SwapHash] -> Encoding
$ctoEncodingList :: [SwapHash] -> Encoding
toJSONList :: [SwapHash] -> Value
$ctoJSONList :: [SwapHash] -> Value
toEncoding :: SwapHash -> Encoding
$ctoEncoding :: SwapHash -> Encoding
toJSON :: SwapHash -> Value
$ctoJSON :: SwapHash -> Value
ToJSON
    )
  deriving stock
    ( (forall x. SwapHash -> Rep SwapHash x)
-> (forall x. Rep SwapHash x -> SwapHash) -> Generic SwapHash
forall x. Rep SwapHash x -> SwapHash
forall x. SwapHash -> Rep SwapHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SwapHash x -> SwapHash
$cfrom :: forall x. SwapHash -> Rep SwapHash x
Generic
    )

instance Out SwapHash

instance ToTypedContent (Maybe SwapHash) where
  toTypedContent :: Maybe SwapHash -> TypedContent
toTypedContent = Value -> TypedContent
forall a. ToTypedContent a => a -> TypedContent
toTypedContent (Value -> TypedContent)
-> (Maybe SwapHash -> Value) -> Maybe SwapHash -> TypedContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SwapHash -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToContent (Maybe SwapHash) where
  toContent :: Maybe SwapHash -> Content
toContent = Value -> Content
forall a. ToContent a => a -> Content
toContent (Value -> Content)
-> (Maybe SwapHash -> Value) -> Maybe SwapHash -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SwapHash -> Value
forall a. ToJSON a => a -> Value
toJSON

data LnInvoiceStatus
  = LnInvoiceStatusNew
  | LnInvoiceStatusLocked
  | LnInvoiceStatusSettled
  | LnInvoiceStatusCancelled
  | LnInvoiceStatusExpired
  deriving stock
    ( (forall x. LnInvoiceStatus -> Rep LnInvoiceStatus x)
-> (forall x. Rep LnInvoiceStatus x -> LnInvoiceStatus)
-> Generic LnInvoiceStatus
forall x. Rep LnInvoiceStatus x -> LnInvoiceStatus
forall x. LnInvoiceStatus -> Rep LnInvoiceStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnInvoiceStatus x -> LnInvoiceStatus
$cfrom :: forall x. LnInvoiceStatus -> Rep LnInvoiceStatus x
Generic,
      Int -> LnInvoiceStatus -> ShowS
[LnInvoiceStatus] -> ShowS
LnInvoiceStatus -> HostName
(Int -> LnInvoiceStatus -> ShowS)
-> (LnInvoiceStatus -> HostName)
-> ([LnInvoiceStatus] -> ShowS)
-> Show LnInvoiceStatus
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [LnInvoiceStatus] -> ShowS
$cshowList :: [LnInvoiceStatus] -> ShowS
show :: LnInvoiceStatus -> HostName
$cshow :: LnInvoiceStatus -> HostName
showsPrec :: Int -> LnInvoiceStatus -> ShowS
$cshowsPrec :: Int -> LnInvoiceStatus -> ShowS
Show,
      ReadPrec [LnInvoiceStatus]
ReadPrec LnInvoiceStatus
Int -> ReadS LnInvoiceStatus
ReadS [LnInvoiceStatus]
(Int -> ReadS LnInvoiceStatus)
-> ReadS [LnInvoiceStatus]
-> ReadPrec LnInvoiceStatus
-> ReadPrec [LnInvoiceStatus]
-> Read LnInvoiceStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LnInvoiceStatus]
$creadListPrec :: ReadPrec [LnInvoiceStatus]
readPrec :: ReadPrec LnInvoiceStatus
$creadPrec :: ReadPrec LnInvoiceStatus
readList :: ReadS [LnInvoiceStatus]
$creadList :: ReadS [LnInvoiceStatus]
readsPrec :: Int -> ReadS LnInvoiceStatus
$creadsPrec :: Int -> ReadS LnInvoiceStatus
Read,
      LnInvoiceStatus -> LnInvoiceStatus -> Bool
(LnInvoiceStatus -> LnInvoiceStatus -> Bool)
-> (LnInvoiceStatus -> LnInvoiceStatus -> Bool)
-> Eq LnInvoiceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnInvoiceStatus -> LnInvoiceStatus -> Bool
$c/= :: LnInvoiceStatus -> LnInvoiceStatus -> Bool
== :: LnInvoiceStatus -> LnInvoiceStatus -> Bool
$c== :: LnInvoiceStatus -> LnInvoiceStatus -> Bool
Eq
    )

instance Out LnInvoiceStatus

data LnChanStatus
  = LnChanStatusPendingOpen
  | LnChanStatusOpened
  | LnChanStatusActive
  | LnChanStatusFullyResolved
  | LnChanStatusInactive
  | LnChanStatusPendingClose
  | LnChanStatusClosed
  deriving stock
    ( (forall x. LnChanStatus -> Rep LnChanStatus x)
-> (forall x. Rep LnChanStatus x -> LnChanStatus)
-> Generic LnChanStatus
forall x. Rep LnChanStatus x -> LnChanStatus
forall x. LnChanStatus -> Rep LnChanStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LnChanStatus x -> LnChanStatus
$cfrom :: forall x. LnChanStatus -> Rep LnChanStatus x
Generic,
      Int -> LnChanStatus -> ShowS
[LnChanStatus] -> ShowS
LnChanStatus -> HostName
(Int -> LnChanStatus -> ShowS)
-> (LnChanStatus -> HostName)
-> ([LnChanStatus] -> ShowS)
-> Show LnChanStatus
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [LnChanStatus] -> ShowS
$cshowList :: [LnChanStatus] -> ShowS
show :: LnChanStatus -> HostName
$cshow :: LnChanStatus -> HostName
showsPrec :: Int -> LnChanStatus -> ShowS
$cshowsPrec :: Int -> LnChanStatus -> ShowS
Show,
      ReadPrec [LnChanStatus]
ReadPrec LnChanStatus
Int -> ReadS LnChanStatus
ReadS [LnChanStatus]
(Int -> ReadS LnChanStatus)
-> ReadS [LnChanStatus]
-> ReadPrec LnChanStatus
-> ReadPrec [LnChanStatus]
-> Read LnChanStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LnChanStatus]
$creadListPrec :: ReadPrec [LnChanStatus]
readPrec :: ReadPrec LnChanStatus
$creadPrec :: ReadPrec LnChanStatus
readList :: ReadS [LnChanStatus]
$creadList :: ReadS [LnChanStatus]
readsPrec :: Int -> ReadS LnChanStatus
$creadsPrec :: Int -> ReadS LnChanStatus
Read,
      LnChanStatus -> LnChanStatus -> Bool
(LnChanStatus -> LnChanStatus -> Bool)
-> (LnChanStatus -> LnChanStatus -> Bool) -> Eq LnChanStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LnChanStatus -> LnChanStatus -> Bool
$c/= :: LnChanStatus -> LnChanStatus -> Bool
== :: LnChanStatus -> LnChanStatus -> Bool
$c== :: LnChanStatus -> LnChanStatus -> Bool
Eq,
      Eq LnChanStatus
Eq LnChanStatus
-> (LnChanStatus -> LnChanStatus -> Ordering)
-> (LnChanStatus -> LnChanStatus -> Bool)
-> (LnChanStatus -> LnChanStatus -> Bool)
-> (LnChanStatus -> LnChanStatus -> Bool)
-> (LnChanStatus -> LnChanStatus -> Bool)
-> (LnChanStatus -> LnChanStatus -> LnChanStatus)
-> (LnChanStatus -> LnChanStatus -> LnChanStatus)
-> Ord LnChanStatus
LnChanStatus -> LnChanStatus -> Bool
LnChanStatus -> LnChanStatus -> Ordering
LnChanStatus -> LnChanStatus -> LnChanStatus
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 :: LnChanStatus -> LnChanStatus -> LnChanStatus
$cmin :: LnChanStatus -> LnChanStatus -> LnChanStatus
max :: LnChanStatus -> LnChanStatus -> LnChanStatus
$cmax :: LnChanStatus -> LnChanStatus -> LnChanStatus
>= :: LnChanStatus -> LnChanStatus -> Bool
$c>= :: LnChanStatus -> LnChanStatus -> Bool
> :: LnChanStatus -> LnChanStatus -> Bool
$c> :: LnChanStatus -> LnChanStatus -> Bool
<= :: LnChanStatus -> LnChanStatus -> Bool
$c<= :: LnChanStatus -> LnChanStatus -> Bool
< :: LnChanStatus -> LnChanStatus -> Bool
$c< :: LnChanStatus -> LnChanStatus -> Bool
compare :: LnChanStatus -> LnChanStatus -> Ordering
$ccompare :: LnChanStatus -> LnChanStatus -> Ordering
Ord
    )

instance Out LnChanStatus

newtype Liquidity (dir :: Direction) = Liquidity
  { forall (dir :: Direction). Liquidity dir -> MSat
unLiquidity :: MSat
  }
  deriving newtype
    ( Liquidity dir -> Liquidity dir -> Bool
(Liquidity dir -> Liquidity dir -> Bool)
-> (Liquidity dir -> Liquidity dir -> Bool) -> Eq (Liquidity dir)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
/= :: Liquidity dir -> Liquidity dir -> Bool
$c/= :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
== :: Liquidity dir -> Liquidity dir -> Bool
$c== :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
Eq,
      Eq (Liquidity dir)
Eq (Liquidity dir)
-> (Liquidity dir -> Liquidity dir -> Ordering)
-> (Liquidity dir -> Liquidity dir -> Bool)
-> (Liquidity dir -> Liquidity dir -> Bool)
-> (Liquidity dir -> Liquidity dir -> Bool)
-> (Liquidity dir -> Liquidity dir -> Bool)
-> (Liquidity dir -> Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir -> Liquidity dir)
-> Ord (Liquidity dir)
Liquidity dir -> Liquidity dir -> Bool
Liquidity dir -> Liquidity dir -> Ordering
Liquidity dir -> Liquidity dir -> Liquidity dir
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 (dir :: Direction). Eq (Liquidity dir)
forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Ordering
forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
min :: Liquidity dir -> Liquidity dir -> Liquidity dir
$cmin :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
max :: Liquidity dir -> Liquidity dir -> Liquidity dir
$cmax :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
>= :: Liquidity dir -> Liquidity dir -> Bool
$c>= :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
> :: Liquidity dir -> Liquidity dir -> Bool
$c> :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
<= :: Liquidity dir -> Liquidity dir -> Bool
$c<= :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
< :: Liquidity dir -> Liquidity dir -> Bool
$c< :: forall (dir :: Direction). Liquidity dir -> Liquidity dir -> Bool
compare :: Liquidity dir -> Liquidity dir -> Ordering
$ccompare :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Ordering
Ord,
      Int -> Liquidity dir -> ShowS
[Liquidity dir] -> ShowS
Liquidity dir -> HostName
(Int -> Liquidity dir -> ShowS)
-> (Liquidity dir -> HostName)
-> ([Liquidity dir] -> ShowS)
-> Show (Liquidity dir)
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
forall (dir :: Direction). Int -> Liquidity dir -> ShowS
forall (dir :: Direction). [Liquidity dir] -> ShowS
forall (dir :: Direction). Liquidity dir -> HostName
showList :: [Liquidity dir] -> ShowS
$cshowList :: forall (dir :: Direction). [Liquidity dir] -> ShowS
show :: Liquidity dir -> HostName
$cshow :: forall (dir :: Direction). Liquidity dir -> HostName
showsPrec :: Int -> Liquidity dir -> ShowS
$cshowsPrec :: forall (dir :: Direction). Int -> Liquidity dir -> ShowS
Show,
      ReadPrec [Liquidity dir]
ReadPrec (Liquidity dir)
Int -> ReadS (Liquidity dir)
ReadS [Liquidity dir]
(Int -> ReadS (Liquidity dir))
-> ReadS [Liquidity dir]
-> ReadPrec (Liquidity dir)
-> ReadPrec [Liquidity dir]
-> Read (Liquidity dir)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (dir :: Direction). ReadPrec [Liquidity dir]
forall (dir :: Direction). ReadPrec (Liquidity dir)
forall (dir :: Direction). Int -> ReadS (Liquidity dir)
forall (dir :: Direction). ReadS [Liquidity dir]
readListPrec :: ReadPrec [Liquidity dir]
$creadListPrec :: forall (dir :: Direction). ReadPrec [Liquidity dir]
readPrec :: ReadPrec (Liquidity dir)
$creadPrec :: forall (dir :: Direction). ReadPrec (Liquidity dir)
readList :: ReadS [Liquidity dir]
$creadList :: forall (dir :: Direction). ReadS [Liquidity dir]
readsPrec :: Int -> ReadS (Liquidity dir)
$creadsPrec :: forall (dir :: Direction). Int -> ReadS (Liquidity dir)
Read,
      Integer -> Liquidity dir
Liquidity dir -> Liquidity dir
Liquidity dir -> Liquidity dir -> Liquidity dir
(Liquidity dir -> Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir)
-> (Liquidity dir -> Liquidity dir)
-> (Integer -> Liquidity dir)
-> Num (Liquidity dir)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (dir :: Direction). Integer -> Liquidity dir
forall (dir :: Direction). Liquidity dir -> Liquidity dir
forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
fromInteger :: Integer -> Liquidity dir
$cfromInteger :: forall (dir :: Direction). Integer -> Liquidity dir
signum :: Liquidity dir -> Liquidity dir
$csignum :: forall (dir :: Direction). Liquidity dir -> Liquidity dir
abs :: Liquidity dir -> Liquidity dir
$cabs :: forall (dir :: Direction). Liquidity dir -> Liquidity dir
negate :: Liquidity dir -> Liquidity dir
$cnegate :: forall (dir :: Direction). Liquidity dir -> Liquidity dir
* :: Liquidity dir -> Liquidity dir -> Liquidity dir
$c* :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
- :: Liquidity dir -> Liquidity dir -> Liquidity dir
$c- :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
+ :: Liquidity dir -> Liquidity dir -> Liquidity dir
$c+ :: forall (dir :: Direction).
Liquidity dir -> Liquidity dir -> Liquidity dir
Num
    )
  deriving stock
    ( (forall x. Liquidity dir -> Rep (Liquidity dir) x)
-> (forall x. Rep (Liquidity dir) x -> Liquidity dir)
-> Generic (Liquidity dir)
forall x. Rep (Liquidity dir) x -> Liquidity dir
forall x. Liquidity dir -> Rep (Liquidity dir) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (dir :: Direction) x. Rep (Liquidity dir) x -> Liquidity dir
forall (dir :: Direction) x. Liquidity dir -> Rep (Liquidity dir) x
$cto :: forall (dir :: Direction) x. Rep (Liquidity dir) x -> Liquidity dir
$cfrom :: forall (dir :: Direction) x. Liquidity dir -> Rep (Liquidity dir) x
Generic
    )

instance Out (Liquidity dir)

newtype
  Money
    (owner :: Owner)
    (btcl :: BitcoinLayer)
    (mrel :: MoneyRelation) = Money
  { forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> MSat
unMoney :: MSat
  }
  deriving newtype
    ( Money owner btcl mrel -> Money owner btcl mrel -> Bool
(Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> Eq (Money owner btcl mrel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
/= :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c/= :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
== :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c== :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
Eq,
      Eq (Money owner btcl mrel)
Eq (Money owner btcl mrel)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Ordering)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> (Money owner btcl mrel -> Money owner btcl mrel -> Bool)
-> (Money owner btcl mrel
    -> Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel
    -> Money owner btcl mrel -> Money owner btcl mrel)
-> Ord (Money owner btcl mrel)
Money owner btcl mrel -> Money owner btcl mrel -> Bool
Money owner btcl mrel -> Money owner btcl mrel -> Ordering
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl 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 (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Eq (Money owner btcl mrel)
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Ordering
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
min :: Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
$cmin :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
max :: Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
$cmax :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
>= :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c>= :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
> :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c> :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
<= :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c<= :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
< :: Money owner btcl mrel -> Money owner btcl mrel -> Bool
$c< :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Bool
compare :: Money owner btcl mrel -> Money owner btcl mrel -> Ordering
$ccompare :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel -> Ordering
Ord,
      Int -> Money owner btcl mrel -> ShowS
[Money owner btcl mrel] -> ShowS
Money owner btcl mrel -> HostName
(Int -> Money owner btcl mrel -> ShowS)
-> (Money owner btcl mrel -> HostName)
-> ([Money owner btcl mrel] -> ShowS)
-> Show (Money owner btcl mrel)
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Int -> Money owner btcl mrel -> ShowS
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
[Money owner btcl mrel] -> ShowS
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> HostName
showList :: [Money owner btcl mrel] -> ShowS
$cshowList :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
[Money owner btcl mrel] -> ShowS
show :: Money owner btcl mrel -> HostName
$cshow :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> HostName
showsPrec :: Int -> Money owner btcl mrel -> ShowS
$cshowsPrec :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Int -> Money owner btcl mrel -> ShowS
Show,
      ReadPrec [Money owner btcl mrel]
ReadPrec (Money owner btcl mrel)
Int -> ReadS (Money owner btcl mrel)
ReadS [Money owner btcl mrel]
(Int -> ReadS (Money owner btcl mrel))
-> ReadS [Money owner btcl mrel]
-> ReadPrec (Money owner btcl mrel)
-> ReadPrec [Money owner btcl mrel]
-> Read (Money owner btcl mrel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadPrec [Money owner btcl mrel]
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadPrec (Money owner btcl mrel)
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Int -> ReadS (Money owner btcl mrel)
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadS [Money owner btcl mrel]
readListPrec :: ReadPrec [Money owner btcl mrel]
$creadListPrec :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadPrec [Money owner btcl mrel]
readPrec :: ReadPrec (Money owner btcl mrel)
$creadPrec :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadPrec (Money owner btcl mrel)
readList :: ReadS [Money owner btcl mrel]
$creadList :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
ReadS [Money owner btcl mrel]
readsPrec :: Int -> ReadS (Money owner btcl mrel)
$creadsPrec :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Int -> ReadS (Money owner btcl mrel)
Read,
      Integer -> Money owner btcl mrel
Money owner btcl mrel -> Money owner btcl mrel
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
(Money owner btcl mrel
 -> Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel
    -> Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel
    -> Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel -> Money owner btcl mrel)
-> (Money owner btcl mrel -> Money owner btcl mrel)
-> (Integer -> Money owner btcl mrel)
-> Num (Money owner btcl mrel)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Integer -> Money owner btcl mrel
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
fromInteger :: Integer -> Money owner btcl mrel
$cfromInteger :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Integer -> Money owner btcl mrel
signum :: Money owner btcl mrel -> Money owner btcl mrel
$csignum :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel
abs :: Money owner btcl mrel -> Money owner btcl mrel
$cabs :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel
negate :: Money owner btcl mrel -> Money owner btcl mrel
$cnegate :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> Money owner btcl mrel
* :: Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
$c* :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
- :: Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
$c- :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
+ :: Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
$c+ :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel
-> Money owner btcl mrel -> Money owner btcl mrel
Num,
      PersistValue -> Either Text (Money owner btcl mrel)
Money owner btcl mrel -> PersistValue
(Money owner btcl mrel -> PersistValue)
-> (PersistValue -> Either Text (Money owner btcl mrel))
-> PersistField (Money owner btcl mrel)
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
PersistValue -> Either Text (Money owner btcl mrel)
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> PersistValue
fromPersistValue :: PersistValue -> Either Text (Money owner btcl mrel)
$cfromPersistValue :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
PersistValue -> Either Text (Money owner btcl mrel)
toPersistValue :: Money owner btcl mrel -> PersistValue
$ctoPersistValue :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Money owner btcl mrel -> PersistValue
Psql.PersistField,
      PersistField (Money owner btcl mrel)
Proxy (Money owner btcl mrel) -> SqlType
PersistField (Money owner btcl mrel)
-> (Proxy (Money owner btcl mrel) -> SqlType)
-> PersistFieldSql (Money owner btcl mrel)
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
PersistField (Money owner btcl mrel)
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Proxy (Money owner btcl mrel) -> SqlType
sqlType :: Proxy (Money owner btcl mrel) -> SqlType
$csqlType :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation).
Proxy (Money owner btcl mrel) -> SqlType
Psql.PersistFieldSql
    )
  deriving stock
    ( (forall x. Money owner btcl mrel -> Rep (Money owner btcl mrel) x)
-> (forall x.
    Rep (Money owner btcl mrel) x -> Money owner btcl mrel)
-> Generic (Money owner btcl mrel)
forall x. Rep (Money owner btcl mrel) x -> Money owner btcl mrel
forall x. Money owner btcl mrel -> Rep (Money owner btcl mrel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation) x.
Rep (Money owner btcl mrel) x -> Money owner btcl mrel
forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation) x.
Money owner btcl mrel -> Rep (Money owner btcl mrel) x
$cto :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation) x.
Rep (Money owner btcl mrel) x -> Money owner btcl mrel
$cfrom :: forall (owner :: Owner) (btcl :: BitcoinLayer)
       (mrel :: MoneyRelation) x.
Money owner btcl mrel -> Rep (Money owner btcl mrel) x
Generic
    )

instance Out (Money owner btcl mrel)

instance From MSat (Money owner btcl mrel)

instance From (Money owner btcl mrel) MSat

instance From Word64 (Money owner btcl mrel) where
  from :: Word64 -> Money owner btcl mrel
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @MSat

instance From (Money owner btcl mrel) Word64 where
  from :: Money owner btcl mrel -> Word64
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @MSat

instance TryFrom Natural (Money owner btcl mrel) where
  tryFrom :: Natural
-> Either
     (TryFromException Natural (Money owner btcl mrel))
     (Money owner btcl mrel)
tryFrom =
    forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @Word64 (Word64 -> Money owner btcl mrel)
-> (Natural -> Either (TryFromException Natural Word64) Word64)
-> Natural
-> Either
     (TryFromException Natural (Money owner btcl mrel))
     (Money owner btcl mrel)
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` Natural -> Either (TryFromException Natural Word64) Word64
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

instance From (Money owner btcl mrel) Natural where
  from :: Money owner btcl mrel -> Natural
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64

instance TryFrom (Ratio Natural) (Money owner btcl mrel) where
  tryFrom :: Ratio Natural
-> Either
     (TryFromException (Ratio Natural) (Money owner btcl mrel))
     (Money owner btcl mrel)
tryFrom =
    forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom @Natural
      (Natural
 -> Either
      (TryFromException Natural (Money owner btcl mrel))
      (Money owner btcl mrel))
-> (Ratio Natural
    -> Either (TryFromException (Ratio Natural) Natural) Natural)
-> Ratio Natural
-> Either
     (TryFromException (Ratio Natural) (Money owner btcl mrel))
     (Money owner btcl mrel)
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> Either (TryFromException through target) target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTry` Ratio Natural
-> Either (TryFromException (Ratio Natural) Natural) Natural
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

instance From (Money owner btcl mrel) (Ratio Natural) where
  from :: Money owner btcl mrel -> Ratio Natural
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Natural

instance TryFrom Rational (Money owner btcl mrel) where
  tryFrom :: Rational
-> Either
     (TryFromException Rational (Money owner btcl mrel))
     (Money owner btcl mrel)
tryFrom =
    forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom @(Ratio Natural)
      (Ratio Natural
 -> Either
      (TryFromException (Ratio Natural) (Money owner btcl mrel))
      (Money owner btcl mrel))
-> (Rational
    -> Either
         (TryFromException Rational (Ratio Natural)) (Ratio Natural))
-> Rational
-> Either
     (TryFromException Rational (Money owner btcl mrel))
     (Money owner btcl mrel)
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> Either (TryFromException through target) target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTry` Rational
-> Either
     (TryFromException Rational (Ratio Natural)) (Ratio Natural)
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

instance From (Money owner btcl mrel) Rational where
  from :: Money owner btcl mrel -> Rational
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @(Ratio Natural)

instance ToMessage (Money owner btcl mrel) where
  toMessage :: Money owner btcl mrel -> Text
toMessage =
    Int -> Rational -> Text
T.displayRational Int
1
      (Rational -> Text)
-> (Money owner btcl mrel -> Rational)
-> Money owner btcl mrel
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000)
      (Rational -> Rational)
-> (Money owner btcl mrel -> Rational)
-> Money owner btcl mrel
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Money owner btcl mrel -> Rational
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from

newtype FeeRate
  = FeeRate (Ratio Word64)
  deriving newtype
    ( FeeRate -> FeeRate -> Bool
(FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool) -> Eq FeeRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeeRate -> FeeRate -> Bool
$c/= :: FeeRate -> FeeRate -> Bool
== :: FeeRate -> FeeRate -> Bool
$c== :: FeeRate -> FeeRate -> Bool
Eq,
      Eq FeeRate
Eq FeeRate
-> (FeeRate -> FeeRate -> Ordering)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> Bool)
-> (FeeRate -> FeeRate -> FeeRate)
-> (FeeRate -> FeeRate -> FeeRate)
-> Ord FeeRate
FeeRate -> FeeRate -> Bool
FeeRate -> FeeRate -> Ordering
FeeRate -> FeeRate -> FeeRate
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 :: FeeRate -> FeeRate -> FeeRate
$cmin :: FeeRate -> FeeRate -> FeeRate
max :: FeeRate -> FeeRate -> FeeRate
$cmax :: FeeRate -> FeeRate -> FeeRate
>= :: FeeRate -> FeeRate -> Bool
$c>= :: FeeRate -> FeeRate -> Bool
> :: FeeRate -> FeeRate -> Bool
$c> :: FeeRate -> FeeRate -> Bool
<= :: FeeRate -> FeeRate -> Bool
$c<= :: FeeRate -> FeeRate -> Bool
< :: FeeRate -> FeeRate -> Bool
$c< :: FeeRate -> FeeRate -> Bool
compare :: FeeRate -> FeeRate -> Ordering
$ccompare :: FeeRate -> FeeRate -> Ordering
Ord,
      Int -> FeeRate -> ShowS
[FeeRate] -> ShowS
FeeRate -> HostName
(Int -> FeeRate -> ShowS)
-> (FeeRate -> HostName) -> ([FeeRate] -> ShowS) -> Show FeeRate
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [FeeRate] -> ShowS
$cshowList :: [FeeRate] -> ShowS
show :: FeeRate -> HostName
$cshow :: FeeRate -> HostName
showsPrec :: Int -> FeeRate -> ShowS
$cshowsPrec :: Int -> FeeRate -> ShowS
Show
    )
  deriving stock
    ( (forall x. FeeRate -> Rep FeeRate x)
-> (forall x. Rep FeeRate x -> FeeRate) -> Generic FeeRate
forall x. Rep FeeRate x -> FeeRate
forall x. FeeRate -> Rep FeeRate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeeRate x -> FeeRate
$cfrom :: forall x. FeeRate -> Rep FeeRate x
Generic
    )

instance From (Ratio Word64) FeeRate

instance From FeeRate (Ratio Word64)

instance From FeeRate (Ratio Natural) where
  from :: FeeRate -> Ratio Natural
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @(Ratio Word64)

instance TryFrom Rational FeeRate where
  tryFrom :: Rational -> Either (TryFromException Rational FeeRate) FeeRate
tryFrom =
    forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @(Ratio Word64)
      (Ratio Word64 -> FeeRate)
-> (Rational
    -> Either
         (TryFromException Rational (Ratio Word64)) (Ratio Word64))
-> Rational
-> Either (TryFromException Rational FeeRate) FeeRate
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` Rational
-> Either (TryFromException Rational (Ratio Word64)) (Ratio Word64)
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

instance From FeeRate Rational where
  from :: FeeRate -> Rational
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @(Ratio Word64)

instance ToMessage FeeRate where
  toMessage :: FeeRate -> Text
toMessage =
    (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%")
      (Text -> Text) -> (FeeRate -> Text) -> FeeRate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational -> Text
T.displayRational Int
1
      (Rational -> Text) -> (FeeRate -> Rational) -> FeeRate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
100)
      (Rational -> Rational)
-> (FeeRate -> Rational) -> FeeRate -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeeRate -> Rational
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from

newtype UnsafeOnChainAddress (mrel :: MoneyRelation)
  = UnsafeOnChainAddress Text
  deriving newtype
    ( UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
(UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> (UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> Eq (UnsafeOnChainAddress mrel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
/= :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c/= :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
== :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c== :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
Eq,
      Eq (UnsafeOnChainAddress mrel)
Eq (UnsafeOnChainAddress mrel)
-> (UnsafeOnChainAddress mrel
    -> UnsafeOnChainAddress mrel -> Ordering)
-> (UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> (UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> (UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> (UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool)
-> (UnsafeOnChainAddress mrel
    -> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel)
-> (UnsafeOnChainAddress mrel
    -> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel)
-> Ord (UnsafeOnChainAddress mrel)
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Ordering
UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress 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 (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Ordering
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel
min :: UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel
$cmin :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel
max :: UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel
$cmax :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel
-> UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel
>= :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c>= :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
> :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c> :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
<= :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c<= :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
< :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
$c< :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Bool
compare :: UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Ordering
$ccompare :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> UnsafeOnChainAddress mrel -> Ordering
Ord,
      Int -> UnsafeOnChainAddress mrel -> ShowS
[UnsafeOnChainAddress mrel] -> ShowS
UnsafeOnChainAddress mrel -> HostName
(Int -> UnsafeOnChainAddress mrel -> ShowS)
-> (UnsafeOnChainAddress mrel -> HostName)
-> ([UnsafeOnChainAddress mrel] -> ShowS)
-> Show (UnsafeOnChainAddress mrel)
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
forall (mrel :: MoneyRelation).
Int -> UnsafeOnChainAddress mrel -> ShowS
forall (mrel :: MoneyRelation).
[UnsafeOnChainAddress mrel] -> ShowS
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> HostName
showList :: [UnsafeOnChainAddress mrel] -> ShowS
$cshowList :: forall (mrel :: MoneyRelation).
[UnsafeOnChainAddress mrel] -> ShowS
show :: UnsafeOnChainAddress mrel -> HostName
$cshow :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> HostName
showsPrec :: Int -> UnsafeOnChainAddress mrel -> ShowS
$cshowsPrec :: forall (mrel :: MoneyRelation).
Int -> UnsafeOnChainAddress mrel -> ShowS
Show,
      ReadPrec [UnsafeOnChainAddress mrel]
ReadPrec (UnsafeOnChainAddress mrel)
Int -> ReadS (UnsafeOnChainAddress mrel)
ReadS [UnsafeOnChainAddress mrel]
(Int -> ReadS (UnsafeOnChainAddress mrel))
-> ReadS [UnsafeOnChainAddress mrel]
-> ReadPrec (UnsafeOnChainAddress mrel)
-> ReadPrec [UnsafeOnChainAddress mrel]
-> Read (UnsafeOnChainAddress mrel)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (mrel :: MoneyRelation).
ReadPrec [UnsafeOnChainAddress mrel]
forall (mrel :: MoneyRelation).
ReadPrec (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation).
Int -> ReadS (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation). ReadS [UnsafeOnChainAddress mrel]
readListPrec :: ReadPrec [UnsafeOnChainAddress mrel]
$creadListPrec :: forall (mrel :: MoneyRelation).
ReadPrec [UnsafeOnChainAddress mrel]
readPrec :: ReadPrec (UnsafeOnChainAddress mrel)
$creadPrec :: forall (mrel :: MoneyRelation).
ReadPrec (UnsafeOnChainAddress mrel)
readList :: ReadS [UnsafeOnChainAddress mrel]
$creadList :: forall (mrel :: MoneyRelation). ReadS [UnsafeOnChainAddress mrel]
readsPrec :: Int -> ReadS (UnsafeOnChainAddress mrel)
$creadsPrec :: forall (mrel :: MoneyRelation).
Int -> ReadS (UnsafeOnChainAddress mrel)
Read,
      Text -> Maybe (UnsafeOnChainAddress mrel)
UnsafeOnChainAddress mrel -> Text
(Text -> Maybe (UnsafeOnChainAddress mrel))
-> (UnsafeOnChainAddress mrel -> Text)
-> PathPiece (UnsafeOnChainAddress mrel)
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
forall (mrel :: MoneyRelation).
Text -> Maybe (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation). UnsafeOnChainAddress mrel -> Text
toPathPiece :: UnsafeOnChainAddress mrel -> Text
$ctoPathPiece :: forall (mrel :: MoneyRelation). UnsafeOnChainAddress mrel -> Text
fromPathPiece :: Text -> Maybe (UnsafeOnChainAddress mrel)
$cfromPathPiece :: forall (mrel :: MoneyRelation).
Text -> Maybe (UnsafeOnChainAddress mrel)
PathPiece,
      PersistValue -> Either Text (UnsafeOnChainAddress mrel)
UnsafeOnChainAddress mrel -> PersistValue
(UnsafeOnChainAddress mrel -> PersistValue)
-> (PersistValue -> Either Text (UnsafeOnChainAddress mrel))
-> PersistField (UnsafeOnChainAddress mrel)
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
forall (mrel :: MoneyRelation).
PersistValue -> Either Text (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> PersistValue
fromPersistValue :: PersistValue -> Either Text (UnsafeOnChainAddress mrel)
$cfromPersistValue :: forall (mrel :: MoneyRelation).
PersistValue -> Either Text (UnsafeOnChainAddress mrel)
toPersistValue :: UnsafeOnChainAddress mrel -> PersistValue
$ctoPersistValue :: forall (mrel :: MoneyRelation).
UnsafeOnChainAddress mrel -> PersistValue
Psql.PersistField,
      PersistField (UnsafeOnChainAddress mrel)
Proxy (UnsafeOnChainAddress mrel) -> SqlType
PersistField (UnsafeOnChainAddress mrel)
-> (Proxy (UnsafeOnChainAddress mrel) -> SqlType)
-> PersistFieldSql (UnsafeOnChainAddress mrel)
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
forall (mrel :: MoneyRelation).
PersistField (UnsafeOnChainAddress mrel)
forall (mrel :: MoneyRelation).
Proxy (UnsafeOnChainAddress mrel) -> SqlType
sqlType :: Proxy (UnsafeOnChainAddress mrel) -> SqlType
$csqlType :: forall (mrel :: MoneyRelation).
Proxy (UnsafeOnChainAddress mrel) -> SqlType
Psql.PersistFieldSql
    )
  deriving stock
    ( (forall x.
 UnsafeOnChainAddress mrel -> Rep (UnsafeOnChainAddress mrel) x)
-> (forall x.
    Rep (UnsafeOnChainAddress mrel) x -> UnsafeOnChainAddress mrel)
-> Generic (UnsafeOnChainAddress mrel)
forall x.
Rep (UnsafeOnChainAddress mrel) x -> UnsafeOnChainAddress mrel
forall x.
UnsafeOnChainAddress mrel -> Rep (UnsafeOnChainAddress mrel) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mrel :: MoneyRelation) x.
Rep (UnsafeOnChainAddress mrel) x -> UnsafeOnChainAddress mrel
forall (mrel :: MoneyRelation) x.
UnsafeOnChainAddress mrel -> Rep (UnsafeOnChainAddress mrel) x
$cto :: forall (mrel :: MoneyRelation) x.
Rep (UnsafeOnChainAddress mrel) x -> UnsafeOnChainAddress mrel
$cfrom :: forall (mrel :: MoneyRelation) x.
UnsafeOnChainAddress mrel -> Rep (UnsafeOnChainAddress mrel) x
Generic
    )

instance Out (UnsafeOnChainAddress mrel)

instance From Text (UnsafeOnChainAddress mrel)

instance From (UnsafeOnChainAddress mrel) Text

data SwapStatus
  = -- | Waiting on-chain funding trx with
    -- given amt from user with
    -- some confirmations.
    SwapWaitingFundChain
  | -- | Swap has been funded on-chain,
    -- need to open LN channel now.
    SwapWaitingPeer
  | -- | Waiting channel opening trx
    -- to be mined with some confirmations.
    SwapWaitingChan
  | -- | Final statuses
    SwapSucceeded
  | SwapExpired
  deriving stock
    ( SwapStatus -> SwapStatus -> Bool
(SwapStatus -> SwapStatus -> Bool)
-> (SwapStatus -> SwapStatus -> Bool) -> Eq SwapStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapStatus -> SwapStatus -> Bool
$c/= :: SwapStatus -> SwapStatus -> Bool
== :: SwapStatus -> SwapStatus -> Bool
$c== :: SwapStatus -> SwapStatus -> Bool
Eq,
      Eq SwapStatus
Eq SwapStatus
-> (SwapStatus -> SwapStatus -> Ordering)
-> (SwapStatus -> SwapStatus -> Bool)
-> (SwapStatus -> SwapStatus -> Bool)
-> (SwapStatus -> SwapStatus -> Bool)
-> (SwapStatus -> SwapStatus -> Bool)
-> (SwapStatus -> SwapStatus -> SwapStatus)
-> (SwapStatus -> SwapStatus -> SwapStatus)
-> Ord SwapStatus
SwapStatus -> SwapStatus -> Bool
SwapStatus -> SwapStatus -> Ordering
SwapStatus -> SwapStatus -> SwapStatus
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 :: SwapStatus -> SwapStatus -> SwapStatus
$cmin :: SwapStatus -> SwapStatus -> SwapStatus
max :: SwapStatus -> SwapStatus -> SwapStatus
$cmax :: SwapStatus -> SwapStatus -> SwapStatus
>= :: SwapStatus -> SwapStatus -> Bool
$c>= :: SwapStatus -> SwapStatus -> Bool
> :: SwapStatus -> SwapStatus -> Bool
$c> :: SwapStatus -> SwapStatus -> Bool
<= :: SwapStatus -> SwapStatus -> Bool
$c<= :: SwapStatus -> SwapStatus -> Bool
< :: SwapStatus -> SwapStatus -> Bool
$c< :: SwapStatus -> SwapStatus -> Bool
compare :: SwapStatus -> SwapStatus -> Ordering
$ccompare :: SwapStatus -> SwapStatus -> Ordering
Ord,
      Int -> SwapStatus -> ShowS
[SwapStatus] -> ShowS
SwapStatus -> HostName
(Int -> SwapStatus -> ShowS)
-> (SwapStatus -> HostName)
-> ([SwapStatus] -> ShowS)
-> Show SwapStatus
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SwapStatus] -> ShowS
$cshowList :: [SwapStatus] -> ShowS
show :: SwapStatus -> HostName
$cshow :: SwapStatus -> HostName
showsPrec :: Int -> SwapStatus -> ShowS
$cshowsPrec :: Int -> SwapStatus -> ShowS
Show,
      ReadPrec [SwapStatus]
ReadPrec SwapStatus
Int -> ReadS SwapStatus
ReadS [SwapStatus]
(Int -> ReadS SwapStatus)
-> ReadS [SwapStatus]
-> ReadPrec SwapStatus
-> ReadPrec [SwapStatus]
-> Read SwapStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapStatus]
$creadListPrec :: ReadPrec [SwapStatus]
readPrec :: ReadPrec SwapStatus
$creadPrec :: ReadPrec SwapStatus
readList :: ReadS [SwapStatus]
$creadList :: ReadS [SwapStatus]
readsPrec :: Int -> ReadS SwapStatus
$creadsPrec :: Int -> ReadS SwapStatus
Read,
      (forall x. SwapStatus -> Rep SwapStatus x)
-> (forall x. Rep SwapStatus x -> SwapStatus) -> Generic SwapStatus
forall x. Rep SwapStatus x -> SwapStatus
forall x. SwapStatus -> Rep SwapStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SwapStatus x -> SwapStatus
$cfrom :: forall x. SwapStatus -> Rep SwapStatus x
Generic,
      Int -> SwapStatus
SwapStatus -> Int
SwapStatus -> [SwapStatus]
SwapStatus -> SwapStatus
SwapStatus -> SwapStatus -> [SwapStatus]
SwapStatus -> SwapStatus -> SwapStatus -> [SwapStatus]
(SwapStatus -> SwapStatus)
-> (SwapStatus -> SwapStatus)
-> (Int -> SwapStatus)
-> (SwapStatus -> Int)
-> (SwapStatus -> [SwapStatus])
-> (SwapStatus -> SwapStatus -> [SwapStatus])
-> (SwapStatus -> SwapStatus -> [SwapStatus])
-> (SwapStatus -> SwapStatus -> SwapStatus -> [SwapStatus])
-> Enum SwapStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SwapStatus -> SwapStatus -> SwapStatus -> [SwapStatus]
$cenumFromThenTo :: SwapStatus -> SwapStatus -> SwapStatus -> [SwapStatus]
enumFromTo :: SwapStatus -> SwapStatus -> [SwapStatus]
$cenumFromTo :: SwapStatus -> SwapStatus -> [SwapStatus]
enumFromThen :: SwapStatus -> SwapStatus -> [SwapStatus]
$cenumFromThen :: SwapStatus -> SwapStatus -> [SwapStatus]
enumFrom :: SwapStatus -> [SwapStatus]
$cenumFrom :: SwapStatus -> [SwapStatus]
fromEnum :: SwapStatus -> Int
$cfromEnum :: SwapStatus -> Int
toEnum :: Int -> SwapStatus
$ctoEnum :: Int -> SwapStatus
pred :: SwapStatus -> SwapStatus
$cpred :: SwapStatus -> SwapStatus
succ :: SwapStatus -> SwapStatus
$csucc :: SwapStatus -> SwapStatus
Enum,
      SwapStatus
SwapStatus -> SwapStatus -> Bounded SwapStatus
forall a. a -> a -> Bounded a
maxBound :: SwapStatus
$cmaxBound :: SwapStatus
minBound :: SwapStatus
$cminBound :: SwapStatus
Bounded
    )

instance Out SwapStatus

swapStatusChain :: [SwapStatus]
swapStatusChain :: [SwapStatus]
swapStatusChain =
  [ SwapStatus
SwapWaitingFundChain,
    SwapStatus
SwapWaitingPeer
  ]

swapStatusLn :: [SwapStatus]
swapStatusLn :: [SwapStatus]
swapStatusLn =
  [ SwapStatus
SwapWaitingChan
  ]

swapStatusFinal :: [SwapStatus]
swapStatusFinal :: [SwapStatus]
swapStatusFinal =
  [ SwapStatus
SwapSucceeded,
    SwapStatus
SwapExpired
  ]

instance PathPiece SwapStatus where
  fromPathPiece :: Text -> Maybe SwapStatus
  fromPathPiece :: Text -> Maybe SwapStatus
fromPathPiece =
    HostName -> Maybe SwapStatus
forall a. Read a => HostName -> Maybe a
readMaybe
      (HostName -> Maybe SwapStatus)
-> (Text -> HostName) -> Text -> Maybe SwapStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HostName
unpack
      (Text -> HostName) -> (Text -> Text) -> Text -> HostName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toTitle
  toPathPiece :: SwapStatus -> Text
  toPathPiece :: SwapStatus -> Text
toPathPiece =
    Text -> Text
T.toLower
      (Text -> Text) -> (SwapStatus -> Text) -> SwapStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwapStatus -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show

data Failure
  = FailureInp FailureInput
  | FailureInt FailureInternal
  deriving stock
    ( Failure -> Failure -> Bool
(Failure -> Failure -> Bool)
-> (Failure -> Failure -> Bool) -> Eq Failure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Failure -> Failure -> Bool
$c/= :: Failure -> Failure -> Bool
== :: Failure -> Failure -> Bool
$c== :: Failure -> Failure -> Bool
Eq,
      Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> HostName
(Int -> Failure -> ShowS)
-> (Failure -> HostName) -> ([Failure] -> ShowS) -> Show Failure
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Failure] -> ShowS
$cshowList :: [Failure] -> ShowS
show :: Failure -> HostName
$cshow :: Failure -> HostName
showsPrec :: Int -> Failure -> ShowS
$cshowsPrec :: Int -> Failure -> ShowS
Show,
      (forall x. Failure -> Rep Failure x)
-> (forall x. Rep Failure x -> Failure) -> Generic Failure
forall x. Rep Failure x -> Failure
forall x. Failure -> Rep Failure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Failure x -> Failure
$cfrom :: forall x. Failure -> Rep Failure x
Generic
    )

instance Out Failure

data FailureInput
  = FailureNonce
  | FailureNonSegwitAddr
  | FailureNonValidAddr
  deriving stock
    ( FailureInput -> FailureInput -> Bool
(FailureInput -> FailureInput -> Bool)
-> (FailureInput -> FailureInput -> Bool) -> Eq FailureInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureInput -> FailureInput -> Bool
$c/= :: FailureInput -> FailureInput -> Bool
== :: FailureInput -> FailureInput -> Bool
$c== :: FailureInput -> FailureInput -> Bool
Eq,
      Int -> FailureInput -> ShowS
[FailureInput] -> ShowS
FailureInput -> HostName
(Int -> FailureInput -> ShowS)
-> (FailureInput -> HostName)
-> ([FailureInput] -> ShowS)
-> Show FailureInput
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [FailureInput] -> ShowS
$cshowList :: [FailureInput] -> ShowS
show :: FailureInput -> HostName
$cshow :: FailureInput -> HostName
showsPrec :: Int -> FailureInput -> ShowS
$cshowsPrec :: Int -> FailureInput -> ShowS
Show,
      (forall x. FailureInput -> Rep FailureInput x)
-> (forall x. Rep FailureInput x -> FailureInput)
-> Generic FailureInput
forall x. Rep FailureInput x -> FailureInput
forall x. FailureInput -> Rep FailureInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FailureInput x -> FailureInput
$cfrom :: forall x. FailureInput -> Rep FailureInput x
Generic
    )

instance Out FailureInput

data FailureInternal
  = FailureGrpcServer Text
  | FailureGrpcClient Text
  | FailureMath Text
  | FailurePrivate Text
  | FailureRedacted
  deriving stock
    ( FailureInternal -> FailureInternal -> Bool
(FailureInternal -> FailureInternal -> Bool)
-> (FailureInternal -> FailureInternal -> Bool)
-> Eq FailureInternal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureInternal -> FailureInternal -> Bool
$c/= :: FailureInternal -> FailureInternal -> Bool
== :: FailureInternal -> FailureInternal -> Bool
$c== :: FailureInternal -> FailureInternal -> Bool
Eq,
      Int -> FailureInternal -> ShowS
[FailureInternal] -> ShowS
FailureInternal -> HostName
(Int -> FailureInternal -> ShowS)
-> (FailureInternal -> HostName)
-> ([FailureInternal] -> ShowS)
-> Show FailureInternal
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [FailureInternal] -> ShowS
$cshowList :: [FailureInternal] -> ShowS
show :: FailureInternal -> HostName
$cshow :: FailureInternal -> HostName
showsPrec :: Int -> FailureInternal -> ShowS
$cshowsPrec :: Int -> FailureInternal -> ShowS
Show,
      (forall x. FailureInternal -> Rep FailureInternal x)
-> (forall x. Rep FailureInternal x -> FailureInternal)
-> Generic FailureInternal
forall x. Rep FailureInternal x -> FailureInternal
forall x. FailureInternal -> Rep FailureInternal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FailureInternal x -> FailureInternal
$cfrom :: forall x. FailureInternal -> Rep FailureInternal x
Generic
    )

instance Out FailureInternal

tryFailureE ::
  forall source target.
  ( Show source,
    Typeable source,
    Typeable target
  ) =>
  Text ->
  Either (TryFromException source target) target ->
  Either Failure target
tryFailureE :: forall source target.
(Show source, Typeable source, Typeable target) =>
Text
-> Either (TryFromException source target) target
-> Either Failure target
tryFailureE Text
label =
  (TryFromException source target -> Failure)
-> Either (TryFromException source target) target
-> Either Failure target
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TryFromException source target -> Failure)
 -> Either (TryFromException source target) target
 -> Either Failure target)
-> (TryFromException source target -> Failure)
-> Either (TryFromException source target) target
-> Either Failure target
forall a b. (a -> b) -> a -> b
$
    FailureInternal -> Failure
FailureInt
      (FailureInternal -> Failure)
-> (TryFromException source target -> FailureInternal)
-> TryFromException source target
-> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FailureInternal
FailureMath
      (Text -> FailureInternal)
-> (TryFromException source target -> Text)
-> TryFromException source target
-> FailureInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (Text -> Text)
-> (TryFromException source target -> Text)
-> TryFromException source target
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (Text -> Text)
-> (TryFromException source target -> Text)
-> TryFromException source target
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TryFromException source target -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show

tryFailureT ::
  forall source target m.
  ( Show source,
    Typeable source,
    Typeable target,
    Monad m
  ) =>
  Text ->
  Either (TryFromException source target) target ->
  ExceptT Failure m target
tryFailureT :: forall source target (m :: * -> *).
(Show source, Typeable source, Typeable target, Monad m) =>
Text
-> Either (TryFromException source target) target
-> ExceptT Failure m target
tryFailureT Text
label =
  Either Failure target -> ExceptT Failure m target
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Failure target -> ExceptT Failure m target)
-> (Either (TryFromException source target) target
    -> Either Failure target)
-> Either (TryFromException source target) target
-> ExceptT Failure m target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (TryFromException source target) target
-> Either Failure target
forall source target.
(Show source, Typeable source, Typeable target) =>
Text
-> Either (TryFromException source target) target
-> Either Failure target
tryFailureE Text
label

tryFromE ::
  forall source target.
  ( Show source,
    Typeable source,
    Typeable target,
    TryFrom source target,
    'False ~ (source == target)
  ) =>
  Text ->
  source ->
  Either Failure target
tryFromE :: forall source target.
(Show source, Typeable source, Typeable target,
 TryFrom source target, 'False ~ (source == target)) =>
Text -> source -> Either Failure target
tryFromE Text
label =
  Text
-> Either (TryFromException source target) target
-> Either Failure target
forall source target.
(Show source, Typeable source, Typeable target) =>
Text
-> Either (TryFromException source target) target
-> Either Failure target
tryFailureE Text
label (Either (TryFromException source target) target
 -> Either Failure target)
-> (source -> Either (TryFromException source target) target)
-> source
-> Either Failure target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. source -> Either (TryFromException source target) target
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

tryFromT ::
  forall source target m.
  ( Show source,
    Typeable source,
    Typeable target,
    TryFrom source target,
    Monad m,
    'False ~ (source == target)
  ) =>
  Text ->
  source ->
  ExceptT Failure m target
tryFromT :: forall source target (m :: * -> *).
(Show source, Typeable source, Typeable target,
 TryFrom source target, Monad m, 'False ~ (source == target)) =>
Text -> source -> ExceptT Failure m target
tryFromT Text
label =
  Either Failure target -> ExceptT Failure m target
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Failure target -> ExceptT Failure m target)
-> (source -> Either Failure target)
-> source
-> ExceptT Failure m target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> source -> Either Failure target
forall source target.
(Show source, Typeable source, Typeable target,
 TryFrom source target, 'False ~ (source == target)) =>
Text -> source -> Either Failure target
tryFromE Text
label

data SocketAddress = SocketAddress
  { SocketAddress -> HostName
socketAddressHost :: HostName,
    SocketAddress -> PortNumber
socketAddressPort :: PortNumber
  }
  deriving stock
    ( SocketAddress -> SocketAddress -> Bool
(SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> Bool) -> Eq SocketAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketAddress -> SocketAddress -> Bool
$c/= :: SocketAddress -> SocketAddress -> Bool
== :: SocketAddress -> SocketAddress -> Bool
$c== :: SocketAddress -> SocketAddress -> Bool
Eq,
      Eq SocketAddress
Eq SocketAddress
-> (SocketAddress -> SocketAddress -> Ordering)
-> (SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> Bool)
-> (SocketAddress -> SocketAddress -> SocketAddress)
-> (SocketAddress -> SocketAddress -> SocketAddress)
-> Ord SocketAddress
SocketAddress -> SocketAddress -> Bool
SocketAddress -> SocketAddress -> Ordering
SocketAddress -> SocketAddress -> SocketAddress
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 :: SocketAddress -> SocketAddress -> SocketAddress
$cmin :: SocketAddress -> SocketAddress -> SocketAddress
max :: SocketAddress -> SocketAddress -> SocketAddress
$cmax :: SocketAddress -> SocketAddress -> SocketAddress
>= :: SocketAddress -> SocketAddress -> Bool
$c>= :: SocketAddress -> SocketAddress -> Bool
> :: SocketAddress -> SocketAddress -> Bool
$c> :: SocketAddress -> SocketAddress -> Bool
<= :: SocketAddress -> SocketAddress -> Bool
$c<= :: SocketAddress -> SocketAddress -> Bool
< :: SocketAddress -> SocketAddress -> Bool
$c< :: SocketAddress -> SocketAddress -> Bool
compare :: SocketAddress -> SocketAddress -> Ordering
$ccompare :: SocketAddress -> SocketAddress -> Ordering
Ord,
      Int -> SocketAddress -> ShowS
[SocketAddress] -> ShowS
SocketAddress -> HostName
(Int -> SocketAddress -> ShowS)
-> (SocketAddress -> HostName)
-> ([SocketAddress] -> ShowS)
-> Show SocketAddress
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SocketAddress] -> ShowS
$cshowList :: [SocketAddress] -> ShowS
show :: SocketAddress -> HostName
$cshow :: SocketAddress -> HostName
showsPrec :: Int -> SocketAddress -> ShowS
$cshowsPrec :: Int -> SocketAddress -> ShowS
Show,
      (forall x. SocketAddress -> Rep SocketAddress x)
-> (forall x. Rep SocketAddress x -> SocketAddress)
-> Generic SocketAddress
forall x. Rep SocketAddress x -> SocketAddress
forall x. SocketAddress -> Rep SocketAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SocketAddress x -> SocketAddress
$cfrom :: forall x. SocketAddress -> Rep SocketAddress x
Generic
    )

instance Out SocketAddress

newtype BlkHash
  = BlkHash Btc.BlockHash
  deriving stock (BlkHash -> BlkHash -> Bool
(BlkHash -> BlkHash -> Bool)
-> (BlkHash -> BlkHash -> Bool) -> Eq BlkHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlkHash -> BlkHash -> Bool
$c/= :: BlkHash -> BlkHash -> Bool
== :: BlkHash -> BlkHash -> Bool
$c== :: BlkHash -> BlkHash -> Bool
Eq, Eq BlkHash
Eq BlkHash
-> (BlkHash -> BlkHash -> Ordering)
-> (BlkHash -> BlkHash -> Bool)
-> (BlkHash -> BlkHash -> Bool)
-> (BlkHash -> BlkHash -> Bool)
-> (BlkHash -> BlkHash -> Bool)
-> (BlkHash -> BlkHash -> BlkHash)
-> (BlkHash -> BlkHash -> BlkHash)
-> Ord BlkHash
BlkHash -> BlkHash -> Bool
BlkHash -> BlkHash -> Ordering
BlkHash -> BlkHash -> BlkHash
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 :: BlkHash -> BlkHash -> BlkHash
$cmin :: BlkHash -> BlkHash -> BlkHash
max :: BlkHash -> BlkHash -> BlkHash
$cmax :: BlkHash -> BlkHash -> BlkHash
>= :: BlkHash -> BlkHash -> Bool
$c>= :: BlkHash -> BlkHash -> Bool
> :: BlkHash -> BlkHash -> Bool
$c> :: BlkHash -> BlkHash -> Bool
<= :: BlkHash -> BlkHash -> Bool
$c<= :: BlkHash -> BlkHash -> Bool
< :: BlkHash -> BlkHash -> Bool
$c< :: BlkHash -> BlkHash -> Bool
compare :: BlkHash -> BlkHash -> Ordering
$ccompare :: BlkHash -> BlkHash -> Ordering
Ord, Int -> BlkHash -> ShowS
[BlkHash] -> ShowS
BlkHash -> HostName
(Int -> BlkHash -> ShowS)
-> (BlkHash -> HostName) -> ([BlkHash] -> ShowS) -> Show BlkHash
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [BlkHash] -> ShowS
$cshowList :: [BlkHash] -> ShowS
show :: BlkHash -> HostName
$cshow :: BlkHash -> HostName
showsPrec :: Int -> BlkHash -> ShowS
$cshowsPrec :: Int -> BlkHash -> ShowS
Show, (forall x. BlkHash -> Rep BlkHash x)
-> (forall x. Rep BlkHash x -> BlkHash) -> Generic BlkHash
forall x. Rep BlkHash x -> BlkHash
forall x. BlkHash -> Rep BlkHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlkHash x -> BlkHash
$cfrom :: forall x. BlkHash -> Rep BlkHash x
Generic)
  deriving newtype (PersistValue -> Either Text BlkHash
BlkHash -> PersistValue
(BlkHash -> PersistValue)
-> (PersistValue -> Either Text BlkHash) -> PersistField BlkHash
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text BlkHash
$cfromPersistValue :: PersistValue -> Either Text BlkHash
toPersistValue :: BlkHash -> PersistValue
$ctoPersistValue :: BlkHash -> PersistValue
Psql.PersistField, PersistField BlkHash
Proxy BlkHash -> SqlType
PersistField BlkHash
-> (Proxy BlkHash -> SqlType) -> PersistFieldSql BlkHash
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy BlkHash -> SqlType
$csqlType :: Proxy BlkHash -> SqlType
Psql.PersistFieldSql)

instance Out BlkHash

instance From Btc.BlockHash BlkHash

instance From BlkHash Btc.BlockHash

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 -> HostName
(Int -> BlkHeight -> ShowS)
-> (BlkHeight -> HostName)
-> ([BlkHeight] -> ShowS)
-> Show BlkHeight
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [BlkHeight] -> ShowS
$cshowList :: [BlkHeight] -> ShowS
show :: BlkHeight -> HostName
$cshow :: BlkHeight -> HostName
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,
      PersistValue -> Either Text BlkHeight
BlkHeight -> PersistValue
(BlkHeight -> PersistValue)
-> (PersistValue -> Either Text BlkHeight)
-> PersistField BlkHeight
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text BlkHeight
$cfromPersistValue :: PersistValue -> Either Text BlkHeight
toPersistValue :: BlkHeight -> PersistValue
$ctoPersistValue :: BlkHeight -> PersistValue
Psql.PersistField,
      PersistField BlkHeight
Proxy BlkHeight -> SqlType
PersistField BlkHeight
-> (Proxy BlkHeight -> SqlType) -> PersistFieldSql BlkHeight
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy BlkHeight -> SqlType
$csqlType :: Proxy BlkHeight -> SqlType
Psql.PersistFieldSql
    )

instance Out BlkHeight

instance ToJSON BlkHeight

instance From Word64 BlkHeight

instance From BlkHeight Word64

instance From BlkHeight Natural where
  from :: BlkHeight -> Natural
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64

instance TryFrom Btc.BlockHeight BlkHeight where
  tryFrom :: Integer -> Either (TryFromException Integer BlkHeight) BlkHeight
tryFrom =
    forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @Word64
      (Word64 -> BlkHeight)
-> (Integer -> Either (TryFromException Integer Word64) Word64)
-> Integer
-> Either (TryFromException Integer BlkHeight) BlkHeight
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` Integer -> Either (TryFromException Integer Word64) Word64
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom

instance From BlkHeight Btc.BlockHeight where
  from :: BlkHeight -> Integer
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64

data BlkStatus
  = BlkConfirmed
  | BlkOrphan
  deriving stock
    ( BlkStatus -> BlkStatus -> Bool
(BlkStatus -> BlkStatus -> Bool)
-> (BlkStatus -> BlkStatus -> Bool) -> Eq BlkStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlkStatus -> BlkStatus -> Bool
$c/= :: BlkStatus -> BlkStatus -> Bool
== :: BlkStatus -> BlkStatus -> Bool
$c== :: BlkStatus -> BlkStatus -> Bool
Eq,
      Eq BlkStatus
Eq BlkStatus
-> (BlkStatus -> BlkStatus -> Ordering)
-> (BlkStatus -> BlkStatus -> Bool)
-> (BlkStatus -> BlkStatus -> Bool)
-> (BlkStatus -> BlkStatus -> Bool)
-> (BlkStatus -> BlkStatus -> Bool)
-> (BlkStatus -> BlkStatus -> BlkStatus)
-> (BlkStatus -> BlkStatus -> BlkStatus)
-> Ord BlkStatus
BlkStatus -> BlkStatus -> Bool
BlkStatus -> BlkStatus -> Ordering
BlkStatus -> BlkStatus -> BlkStatus
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 :: BlkStatus -> BlkStatus -> BlkStatus
$cmin :: BlkStatus -> BlkStatus -> BlkStatus
max :: BlkStatus -> BlkStatus -> BlkStatus
$cmax :: BlkStatus -> BlkStatus -> BlkStatus
>= :: BlkStatus -> BlkStatus -> Bool
$c>= :: BlkStatus -> BlkStatus -> Bool
> :: BlkStatus -> BlkStatus -> Bool
$c> :: BlkStatus -> BlkStatus -> Bool
<= :: BlkStatus -> BlkStatus -> Bool
$c<= :: BlkStatus -> BlkStatus -> Bool
< :: BlkStatus -> BlkStatus -> Bool
$c< :: BlkStatus -> BlkStatus -> Bool
compare :: BlkStatus -> BlkStatus -> Ordering
$ccompare :: BlkStatus -> BlkStatus -> Ordering
Ord,
      Int -> BlkStatus -> ShowS
[BlkStatus] -> ShowS
BlkStatus -> HostName
(Int -> BlkStatus -> ShowS)
-> (BlkStatus -> HostName)
-> ([BlkStatus] -> ShowS)
-> Show BlkStatus
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [BlkStatus] -> ShowS
$cshowList :: [BlkStatus] -> ShowS
show :: BlkStatus -> HostName
$cshow :: BlkStatus -> HostName
showsPrec :: Int -> BlkStatus -> ShowS
$cshowsPrec :: Int -> BlkStatus -> ShowS
Show,
      ReadPrec [BlkStatus]
ReadPrec BlkStatus
Int -> ReadS BlkStatus
ReadS [BlkStatus]
(Int -> ReadS BlkStatus)
-> ReadS [BlkStatus]
-> ReadPrec BlkStatus
-> ReadPrec [BlkStatus]
-> Read BlkStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlkStatus]
$creadListPrec :: ReadPrec [BlkStatus]
readPrec :: ReadPrec BlkStatus
$creadPrec :: ReadPrec BlkStatus
readList :: ReadS [BlkStatus]
$creadList :: ReadS [BlkStatus]
readsPrec :: Int -> ReadS BlkStatus
$creadsPrec :: Int -> ReadS BlkStatus
Read,
      (forall x. BlkStatus -> Rep BlkStatus x)
-> (forall x. Rep BlkStatus x -> BlkStatus) -> Generic BlkStatus
forall x. Rep BlkStatus x -> BlkStatus
forall x. BlkStatus -> Rep BlkStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlkStatus x -> BlkStatus
$cfrom :: forall x. BlkStatus -> Rep BlkStatus x
Generic
    )

instance Out BlkStatus

data SwapUtxoStatus
  = SwapUtxoUnspent
  | SwapUtxoUnspentDust
  | SwapUtxoUnspentChanReserve
  | SwapUtxoSpentChanSwapped
  | SwapUtxoSpentRefund
  | SwapUtxoOrphan
  deriving stock
    ( SwapUtxoStatus -> SwapUtxoStatus -> Bool
(SwapUtxoStatus -> SwapUtxoStatus -> Bool)
-> (SwapUtxoStatus -> SwapUtxoStatus -> Bool) -> Eq SwapUtxoStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c/= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
== :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c== :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
Eq,
      Eq SwapUtxoStatus
Eq SwapUtxoStatus
-> (SwapUtxoStatus -> SwapUtxoStatus -> Ordering)
-> (SwapUtxoStatus -> SwapUtxoStatus -> Bool)
-> (SwapUtxoStatus -> SwapUtxoStatus -> Bool)
-> (SwapUtxoStatus -> SwapUtxoStatus -> Bool)
-> (SwapUtxoStatus -> SwapUtxoStatus -> Bool)
-> (SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus)
-> (SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus)
-> Ord SwapUtxoStatus
SwapUtxoStatus -> SwapUtxoStatus -> Bool
SwapUtxoStatus -> SwapUtxoStatus -> Ordering
SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus
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 :: SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus
$cmin :: SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus
max :: SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus
$cmax :: SwapUtxoStatus -> SwapUtxoStatus -> SwapUtxoStatus
>= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c>= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
> :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c> :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
<= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c<= :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
< :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
$c< :: SwapUtxoStatus -> SwapUtxoStatus -> Bool
compare :: SwapUtxoStatus -> SwapUtxoStatus -> Ordering
$ccompare :: SwapUtxoStatus -> SwapUtxoStatus -> Ordering
Ord,
      Int -> SwapUtxoStatus -> ShowS
[SwapUtxoStatus] -> ShowS
SwapUtxoStatus -> HostName
(Int -> SwapUtxoStatus -> ShowS)
-> (SwapUtxoStatus -> HostName)
-> ([SwapUtxoStatus] -> ShowS)
-> Show SwapUtxoStatus
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SwapUtxoStatus] -> ShowS
$cshowList :: [SwapUtxoStatus] -> ShowS
show :: SwapUtxoStatus -> HostName
$cshow :: SwapUtxoStatus -> HostName
showsPrec :: Int -> SwapUtxoStatus -> ShowS
$cshowsPrec :: Int -> SwapUtxoStatus -> ShowS
Show,
      ReadPrec [SwapUtxoStatus]
ReadPrec SwapUtxoStatus
Int -> ReadS SwapUtxoStatus
ReadS [SwapUtxoStatus]
(Int -> ReadS SwapUtxoStatus)
-> ReadS [SwapUtxoStatus]
-> ReadPrec SwapUtxoStatus
-> ReadPrec [SwapUtxoStatus]
-> Read SwapUtxoStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapUtxoStatus]
$creadListPrec :: ReadPrec [SwapUtxoStatus]
readPrec :: ReadPrec SwapUtxoStatus
$creadPrec :: ReadPrec SwapUtxoStatus
readList :: ReadS [SwapUtxoStatus]
$creadList :: ReadS [SwapUtxoStatus]
readsPrec :: Int -> ReadS SwapUtxoStatus
$creadsPrec :: Int -> ReadS SwapUtxoStatus
Read,
      (forall x. SwapUtxoStatus -> Rep SwapUtxoStatus x)
-> (forall x. Rep SwapUtxoStatus x -> SwapUtxoStatus)
-> Generic SwapUtxoStatus
forall x. Rep SwapUtxoStatus x -> SwapUtxoStatus
forall x. SwapUtxoStatus -> Rep SwapUtxoStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SwapUtxoStatus x -> SwapUtxoStatus
$cfrom :: forall x. SwapUtxoStatus -> Rep SwapUtxoStatus x
Generic
    )

instance Out SwapUtxoStatus

data Privacy
  = Public
  | Private
  deriving stock
    ( Privacy -> Privacy -> Bool
(Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool) -> Eq Privacy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Privacy -> Privacy -> Bool
$c/= :: Privacy -> Privacy -> Bool
== :: Privacy -> Privacy -> Bool
$c== :: Privacy -> Privacy -> Bool
Eq,
      Eq Privacy
Eq Privacy
-> (Privacy -> Privacy -> Ordering)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Privacy)
-> (Privacy -> Privacy -> Privacy)
-> Ord Privacy
Privacy -> Privacy -> Bool
Privacy -> Privacy -> Ordering
Privacy -> Privacy -> Privacy
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 :: Privacy -> Privacy -> Privacy
$cmin :: Privacy -> Privacy -> Privacy
max :: Privacy -> Privacy -> Privacy
$cmax :: Privacy -> Privacy -> Privacy
>= :: Privacy -> Privacy -> Bool
$c>= :: Privacy -> Privacy -> Bool
> :: Privacy -> Privacy -> Bool
$c> :: Privacy -> Privacy -> Bool
<= :: Privacy -> Privacy -> Bool
$c<= :: Privacy -> Privacy -> Bool
< :: Privacy -> Privacy -> Bool
$c< :: Privacy -> Privacy -> Bool
compare :: Privacy -> Privacy -> Ordering
$ccompare :: Privacy -> Privacy -> Ordering
Ord,
      Int -> Privacy -> ShowS
[Privacy] -> ShowS
Privacy -> HostName
(Int -> Privacy -> ShowS)
-> (Privacy -> HostName) -> ([Privacy] -> ShowS) -> Show Privacy
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Privacy] -> ShowS
$cshowList :: [Privacy] -> ShowS
show :: Privacy -> HostName
$cshow :: Privacy -> HostName
showsPrec :: Int -> Privacy -> ShowS
$cshowsPrec :: Int -> Privacy -> ShowS
Show,
      ReadPrec [Privacy]
ReadPrec Privacy
Int -> ReadS Privacy
ReadS [Privacy]
(Int -> ReadS Privacy)
-> ReadS [Privacy]
-> ReadPrec Privacy
-> ReadPrec [Privacy]
-> Read Privacy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Privacy]
$creadListPrec :: ReadPrec [Privacy]
readPrec :: ReadPrec Privacy
$creadPrec :: ReadPrec Privacy
readList :: ReadS [Privacy]
$creadList :: ReadS [Privacy]
readsPrec :: Int -> ReadS Privacy
$creadsPrec :: Int -> ReadS Privacy
Read,
      Int -> Privacy
Privacy -> Int
Privacy -> [Privacy]
Privacy -> Privacy
Privacy -> Privacy -> [Privacy]
Privacy -> Privacy -> Privacy -> [Privacy]
(Privacy -> Privacy)
-> (Privacy -> Privacy)
-> (Int -> Privacy)
-> (Privacy -> Int)
-> (Privacy -> [Privacy])
-> (Privacy -> Privacy -> [Privacy])
-> (Privacy -> Privacy -> [Privacy])
-> (Privacy -> Privacy -> Privacy -> [Privacy])
-> Enum Privacy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Privacy -> Privacy -> Privacy -> [Privacy]
$cenumFromThenTo :: Privacy -> Privacy -> Privacy -> [Privacy]
enumFromTo :: Privacy -> Privacy -> [Privacy]
$cenumFromTo :: Privacy -> Privacy -> [Privacy]
enumFromThen :: Privacy -> Privacy -> [Privacy]
$cenumFromThen :: Privacy -> Privacy -> [Privacy]
enumFrom :: Privacy -> [Privacy]
$cenumFrom :: Privacy -> [Privacy]
fromEnum :: Privacy -> Int
$cfromEnum :: Privacy -> Int
toEnum :: Int -> Privacy
$ctoEnum :: Int -> Privacy
pred :: Privacy -> Privacy
$cpred :: Privacy -> Privacy
succ :: Privacy -> Privacy
$csucc :: Privacy -> Privacy
Enum,
      Privacy
Privacy -> Privacy -> Bounded Privacy
forall a. a -> a -> Bounded a
maxBound :: Privacy
$cmaxBound :: Privacy
minBound :: Privacy
$cminBound :: Privacy
Bounded,
      (forall x. Privacy -> Rep Privacy x)
-> (forall x. Rep Privacy x -> Privacy) -> Generic Privacy
forall x. Rep Privacy x -> Privacy
forall x. Privacy -> Rep Privacy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Privacy x -> Privacy
$cfrom :: forall x. Privacy -> Rep Privacy x
Generic
    )

instance Out Privacy

newtype NodePubKeyHex
  = NodePubKeyHex Text
  deriving newtype (NodePubKeyHex -> NodePubKeyHex -> Bool
(NodePubKeyHex -> NodePubKeyHex -> Bool)
-> (NodePubKeyHex -> NodePubKeyHex -> Bool) -> Eq NodePubKeyHex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c/= :: NodePubKeyHex -> NodePubKeyHex -> Bool
== :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c== :: NodePubKeyHex -> NodePubKeyHex -> Bool
Eq, Eq NodePubKeyHex
Eq NodePubKeyHex
-> (NodePubKeyHex -> NodePubKeyHex -> Ordering)
-> (NodePubKeyHex -> NodePubKeyHex -> Bool)
-> (NodePubKeyHex -> NodePubKeyHex -> Bool)
-> (NodePubKeyHex -> NodePubKeyHex -> Bool)
-> (NodePubKeyHex -> NodePubKeyHex -> Bool)
-> (NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex)
-> (NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex)
-> Ord NodePubKeyHex
NodePubKeyHex -> NodePubKeyHex -> Bool
NodePubKeyHex -> NodePubKeyHex -> Ordering
NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex
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 :: NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex
$cmin :: NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex
max :: NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex
$cmax :: NodePubKeyHex -> NodePubKeyHex -> NodePubKeyHex
>= :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c>= :: NodePubKeyHex -> NodePubKeyHex -> Bool
> :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c> :: NodePubKeyHex -> NodePubKeyHex -> Bool
<= :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c<= :: NodePubKeyHex -> NodePubKeyHex -> Bool
< :: NodePubKeyHex -> NodePubKeyHex -> Bool
$c< :: NodePubKeyHex -> NodePubKeyHex -> Bool
compare :: NodePubKeyHex -> NodePubKeyHex -> Ordering
$ccompare :: NodePubKeyHex -> NodePubKeyHex -> Ordering
Ord, Int -> NodePubKeyHex -> ShowS
[NodePubKeyHex] -> ShowS
NodePubKeyHex -> HostName
(Int -> NodePubKeyHex -> ShowS)
-> (NodePubKeyHex -> HostName)
-> ([NodePubKeyHex] -> ShowS)
-> Show NodePubKeyHex
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [NodePubKeyHex] -> ShowS
$cshowList :: [NodePubKeyHex] -> ShowS
show :: NodePubKeyHex -> HostName
$cshow :: NodePubKeyHex -> HostName
showsPrec :: Int -> NodePubKeyHex -> ShowS
$cshowsPrec :: Int -> NodePubKeyHex -> ShowS
Show, ReadPrec [NodePubKeyHex]
ReadPrec NodePubKeyHex
Int -> ReadS NodePubKeyHex
ReadS [NodePubKeyHex]
(Int -> ReadS NodePubKeyHex)
-> ReadS [NodePubKeyHex]
-> ReadPrec NodePubKeyHex
-> ReadPrec [NodePubKeyHex]
-> Read NodePubKeyHex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodePubKeyHex]
$creadListPrec :: ReadPrec [NodePubKeyHex]
readPrec :: ReadPrec NodePubKeyHex
$creadPrec :: ReadPrec NodePubKeyHex
readList :: ReadS [NodePubKeyHex]
$creadList :: ReadS [NodePubKeyHex]
readsPrec :: Int -> ReadS NodePubKeyHex
$creadsPrec :: Int -> ReadS NodePubKeyHex
Read, HostName -> NodePubKeyHex
(HostName -> NodePubKeyHex) -> IsString NodePubKeyHex
forall a. (HostName -> a) -> IsString a
fromString :: HostName -> NodePubKeyHex
$cfromString :: HostName -> NodePubKeyHex
IsString)
  deriving stock ((forall x. NodePubKeyHex -> Rep NodePubKeyHex x)
-> (forall x. Rep NodePubKeyHex x -> NodePubKeyHex)
-> Generic NodePubKeyHex
forall x. Rep NodePubKeyHex x -> NodePubKeyHex
forall x. NodePubKeyHex -> Rep NodePubKeyHex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodePubKeyHex x -> NodePubKeyHex
$cfrom :: forall x. NodePubKeyHex -> Rep NodePubKeyHex x
Generic)

instance Out NodePubKeyHex

instance From NodePubKeyHex Text

instance From Text NodePubKeyHex

instance TryFrom NodePubKey NodePubKeyHex where
  tryFrom :: NodePubKey
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
tryFrom NodePubKey
src =
    Text -> NodePubKeyHex
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from
      (Text -> NodePubKeyHex)
-> (NodePubKey -> Either (TryFromException NodePubKey Text) Text)
-> NodePubKey
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
forall through source target.
('False ~ (source == through), 'False ~ (through == target)) =>
(through -> target)
-> (source -> Either (TryFromException source through) through)
-> source
-> Either (TryFromException source target) target
`composeTryRhs` ( (UnicodeException -> TryFromException NodePubKey Text)
-> Either UnicodeException Text
-> Either (TryFromException NodePubKey Text) Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                          ( NodePubKey
-> Maybe SomeException -> TryFromException NodePubKey Text
forall source target.
source -> Maybe SomeException -> TryFromException source target
TryFromException NodePubKey
src
                              (Maybe SomeException -> TryFromException NodePubKey Text)
-> (UnicodeException -> Maybe SomeException)
-> UnicodeException
-> TryFromException NodePubKey Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just
                              (SomeException -> Maybe SomeException)
-> (UnicodeException -> SomeException)
-> UnicodeException
-> Maybe SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> SomeException
forall e. Exception e => e -> SomeException
toException
                          )
                          (Either UnicodeException Text
 -> Either (TryFromException NodePubKey Text) Text)
-> (NodePubKey -> Either UnicodeException Text)
-> NodePubKey
-> Either (TryFromException NodePubKey Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8'
                          (ByteString -> Either UnicodeException Text)
-> (NodePubKey -> ByteString)
-> NodePubKey
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
                          (ByteString -> ByteString)
-> (NodePubKey -> ByteString) -> NodePubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodePubKey -> ByteString
coerce
                      )
      (NodePubKey
 -> Either
      (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex)
-> NodePubKey
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
forall a b. (a -> b) -> a -> b
$ NodePubKey
src

newtype UtxoLockId = UtxoLockId ByteString
  deriving newtype (UtxoLockId -> UtxoLockId -> Bool
(UtxoLockId -> UtxoLockId -> Bool)
-> (UtxoLockId -> UtxoLockId -> Bool) -> Eq UtxoLockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoLockId -> UtxoLockId -> Bool
$c/= :: UtxoLockId -> UtxoLockId -> Bool
== :: UtxoLockId -> UtxoLockId -> Bool
$c== :: UtxoLockId -> UtxoLockId -> Bool
Eq, Eq UtxoLockId
Eq UtxoLockId
-> (UtxoLockId -> UtxoLockId -> Ordering)
-> (UtxoLockId -> UtxoLockId -> Bool)
-> (UtxoLockId -> UtxoLockId -> Bool)
-> (UtxoLockId -> UtxoLockId -> Bool)
-> (UtxoLockId -> UtxoLockId -> Bool)
-> (UtxoLockId -> UtxoLockId -> UtxoLockId)
-> (UtxoLockId -> UtxoLockId -> UtxoLockId)
-> Ord UtxoLockId
UtxoLockId -> UtxoLockId -> Bool
UtxoLockId -> UtxoLockId -> Ordering
UtxoLockId -> UtxoLockId -> UtxoLockId
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 :: UtxoLockId -> UtxoLockId -> UtxoLockId
$cmin :: UtxoLockId -> UtxoLockId -> UtxoLockId
max :: UtxoLockId -> UtxoLockId -> UtxoLockId
$cmax :: UtxoLockId -> UtxoLockId -> UtxoLockId
>= :: UtxoLockId -> UtxoLockId -> Bool
$c>= :: UtxoLockId -> UtxoLockId -> Bool
> :: UtxoLockId -> UtxoLockId -> Bool
$c> :: UtxoLockId -> UtxoLockId -> Bool
<= :: UtxoLockId -> UtxoLockId -> Bool
$c<= :: UtxoLockId -> UtxoLockId -> Bool
< :: UtxoLockId -> UtxoLockId -> Bool
$c< :: UtxoLockId -> UtxoLockId -> Bool
compare :: UtxoLockId -> UtxoLockId -> Ordering
$ccompare :: UtxoLockId -> UtxoLockId -> Ordering
Ord, Int -> UtxoLockId -> ShowS
[UtxoLockId] -> ShowS
UtxoLockId -> HostName
(Int -> UtxoLockId -> ShowS)
-> (UtxoLockId -> HostName)
-> ([UtxoLockId] -> ShowS)
-> Show UtxoLockId
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [UtxoLockId] -> ShowS
$cshowList :: [UtxoLockId] -> ShowS
show :: UtxoLockId -> HostName
$cshow :: UtxoLockId -> HostName
showsPrec :: Int -> UtxoLockId -> ShowS
$cshowsPrec :: Int -> UtxoLockId -> ShowS
Show, ReadPrec [UtxoLockId]
ReadPrec UtxoLockId
Int -> ReadS UtxoLockId
ReadS [UtxoLockId]
(Int -> ReadS UtxoLockId)
-> ReadS [UtxoLockId]
-> ReadPrec UtxoLockId
-> ReadPrec [UtxoLockId]
-> Read UtxoLockId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UtxoLockId]
$creadListPrec :: ReadPrec [UtxoLockId]
readPrec :: ReadPrec UtxoLockId
$creadPrec :: ReadPrec UtxoLockId
readList :: ReadS [UtxoLockId]
$creadList :: ReadS [UtxoLockId]
readsPrec :: Int -> ReadS UtxoLockId
$creadsPrec :: Int -> ReadS UtxoLockId
Read)
  deriving stock ((forall x. UtxoLockId -> Rep UtxoLockId x)
-> (forall x. Rep UtxoLockId x -> UtxoLockId) -> Generic UtxoLockId
forall x. Rep UtxoLockId x -> UtxoLockId
forall x. UtxoLockId -> Rep UtxoLockId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoLockId x -> UtxoLockId
$cfrom :: forall x. UtxoLockId -> Rep UtxoLockId x
Generic)

instance Out UtxoLockId

data NodeUri = NodeUri
  { NodeUri -> NodePubKey
nodeUriPubKey :: NodePubKey,
    NodeUri -> SocketAddress
nodeUriSocketAddress :: SocketAddress
  }
  deriving stock
    ( NodeUri -> NodeUri -> Bool
(NodeUri -> NodeUri -> Bool)
-> (NodeUri -> NodeUri -> Bool) -> Eq NodeUri
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeUri -> NodeUri -> Bool
$c/= :: NodeUri -> NodeUri -> Bool
== :: NodeUri -> NodeUri -> Bool
$c== :: NodeUri -> NodeUri -> Bool
Eq,
      Eq NodeUri
Eq NodeUri
-> (NodeUri -> NodeUri -> Ordering)
-> (NodeUri -> NodeUri -> Bool)
-> (NodeUri -> NodeUri -> Bool)
-> (NodeUri -> NodeUri -> Bool)
-> (NodeUri -> NodeUri -> Bool)
-> (NodeUri -> NodeUri -> NodeUri)
-> (NodeUri -> NodeUri -> NodeUri)
-> Ord NodeUri
NodeUri -> NodeUri -> Bool
NodeUri -> NodeUri -> Ordering
NodeUri -> NodeUri -> NodeUri
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 :: NodeUri -> NodeUri -> NodeUri
$cmin :: NodeUri -> NodeUri -> NodeUri
max :: NodeUri -> NodeUri -> NodeUri
$cmax :: NodeUri -> NodeUri -> NodeUri
>= :: NodeUri -> NodeUri -> Bool
$c>= :: NodeUri -> NodeUri -> Bool
> :: NodeUri -> NodeUri -> Bool
$c> :: NodeUri -> NodeUri -> Bool
<= :: NodeUri -> NodeUri -> Bool
$c<= :: NodeUri -> NodeUri -> Bool
< :: NodeUri -> NodeUri -> Bool
$c< :: NodeUri -> NodeUri -> Bool
compare :: NodeUri -> NodeUri -> Ordering
$ccompare :: NodeUri -> NodeUri -> Ordering
Ord,
      Int -> NodeUri -> ShowS
[NodeUri] -> ShowS
NodeUri -> HostName
(Int -> NodeUri -> ShowS)
-> (NodeUri -> HostName) -> ([NodeUri] -> ShowS) -> Show NodeUri
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [NodeUri] -> ShowS
$cshowList :: [NodeUri] -> ShowS
show :: NodeUri -> HostName
$cshow :: NodeUri -> HostName
showsPrec :: Int -> NodeUri -> ShowS
$cshowsPrec :: Int -> NodeUri -> ShowS
Show,
      (forall x. NodeUri -> Rep NodeUri x)
-> (forall x. Rep NodeUri x -> NodeUri) -> Generic NodeUri
forall x. Rep NodeUri x -> NodeUri
forall x. NodeUri -> Rep NodeUri x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeUri x -> NodeUri
$cfrom :: forall x. NodeUri -> Rep NodeUri x
Generic
    )

instance Out NodeUri

newtype NodeUriHex
  = NodeUriHex Text
  deriving newtype (NodeUriHex -> NodeUriHex -> Bool
(NodeUriHex -> NodeUriHex -> Bool)
-> (NodeUriHex -> NodeUriHex -> Bool) -> Eq NodeUriHex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeUriHex -> NodeUriHex -> Bool
$c/= :: NodeUriHex -> NodeUriHex -> Bool
== :: NodeUriHex -> NodeUriHex -> Bool
$c== :: NodeUriHex -> NodeUriHex -> Bool
Eq, Eq NodeUriHex
Eq NodeUriHex
-> (NodeUriHex -> NodeUriHex -> Ordering)
-> (NodeUriHex -> NodeUriHex -> Bool)
-> (NodeUriHex -> NodeUriHex -> Bool)
-> (NodeUriHex -> NodeUriHex -> Bool)
-> (NodeUriHex -> NodeUriHex -> Bool)
-> (NodeUriHex -> NodeUriHex -> NodeUriHex)
-> (NodeUriHex -> NodeUriHex -> NodeUriHex)
-> Ord NodeUriHex
NodeUriHex -> NodeUriHex -> Bool
NodeUriHex -> NodeUriHex -> Ordering
NodeUriHex -> NodeUriHex -> NodeUriHex
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 :: NodeUriHex -> NodeUriHex -> NodeUriHex
$cmin :: NodeUriHex -> NodeUriHex -> NodeUriHex
max :: NodeUriHex -> NodeUriHex -> NodeUriHex
$cmax :: NodeUriHex -> NodeUriHex -> NodeUriHex
>= :: NodeUriHex -> NodeUriHex -> Bool
$c>= :: NodeUriHex -> NodeUriHex -> Bool
> :: NodeUriHex -> NodeUriHex -> Bool
$c> :: NodeUriHex -> NodeUriHex -> Bool
<= :: NodeUriHex -> NodeUriHex -> Bool
$c<= :: NodeUriHex -> NodeUriHex -> Bool
< :: NodeUriHex -> NodeUriHex -> Bool
$c< :: NodeUriHex -> NodeUriHex -> Bool
compare :: NodeUriHex -> NodeUriHex -> Ordering
$ccompare :: NodeUriHex -> NodeUriHex -> Ordering
Ord, Int -> NodeUriHex -> ShowS
[NodeUriHex] -> ShowS
NodeUriHex -> HostName
(Int -> NodeUriHex -> ShowS)
-> (NodeUriHex -> HostName)
-> ([NodeUriHex] -> ShowS)
-> Show NodeUriHex
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [NodeUriHex] -> ShowS
$cshowList :: [NodeUriHex] -> ShowS
show :: NodeUriHex -> HostName
$cshow :: NodeUriHex -> HostName
showsPrec :: Int -> NodeUriHex -> ShowS
$cshowsPrec :: Int -> NodeUriHex -> ShowS
Show, ReadPrec [NodeUriHex]
ReadPrec NodeUriHex
Int -> ReadS NodeUriHex
ReadS [NodeUriHex]
(Int -> ReadS NodeUriHex)
-> ReadS [NodeUriHex]
-> ReadPrec NodeUriHex
-> ReadPrec [NodeUriHex]
-> Read NodeUriHex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodeUriHex]
$creadListPrec :: ReadPrec [NodeUriHex]
readPrec :: ReadPrec NodeUriHex
$creadPrec :: ReadPrec NodeUriHex
readList :: ReadS [NodeUriHex]
$creadList :: ReadS [NodeUriHex]
readsPrec :: Int -> ReadS NodeUriHex
$creadsPrec :: Int -> ReadS NodeUriHex
Read, HostName -> NodeUriHex
(HostName -> NodeUriHex) -> IsString NodeUriHex
forall a. (HostName -> a) -> IsString a
fromString :: HostName -> NodeUriHex
$cfromString :: HostName -> NodeUriHex
IsString)
  deriving stock ((forall x. NodeUriHex -> Rep NodeUriHex x)
-> (forall x. Rep NodeUriHex x -> NodeUriHex) -> Generic NodeUriHex
forall x. Rep NodeUriHex x -> NodeUriHex
forall x. NodeUriHex -> Rep NodeUriHex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeUriHex x -> NodeUriHex
$cfrom :: forall x. NodeUriHex -> Rep NodeUriHex x
Generic)

instance Out NodeUriHex

instance From NodeUriHex Text

instance From Text NodeUriHex

instance TryFrom NodeUri NodeUriHex where
  tryFrom :: NodeUri -> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
tryFrom NodeUri
src =
    (TryFromException NodePubKey NodePubKeyHex
 -> TryFromException NodeUri NodeUriHex)
-> (NodePubKeyHex -> NodeUriHex)
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
-> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (forall target2 source target1.
TryFromException source target1 -> TryFromException source target2
withTarget @NodeUriHex (TryFromException NodeUri NodePubKeyHex
 -> TryFromException NodeUri NodeUriHex)
-> (TryFromException NodePubKey NodePubKeyHex
    -> TryFromException NodeUri NodePubKeyHex)
-> TryFromException NodePubKey NodePubKeyHex
-> TryFromException NodeUri NodeUriHex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeUri
-> TryFromException NodePubKey NodePubKeyHex
-> TryFromException NodeUri NodePubKeyHex
forall source2 source1 t.
source2 -> TryFromException source1 t -> TryFromException source2 t
withSource NodeUri
src)
      ( \NodePubKeyHex
pubHex ->
          forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @Text (Text -> NodeUriHex) -> Text -> NodeUriHex
forall a b. (a -> b) -> a -> b
$
            NodePubKeyHex -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from NodePubKeyHex
pubHex
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HostName -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from HostName
host
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HostName -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (PortNumber -> HostName
forall a. Integral a => a -> HostName
showIntegral PortNumber
port)
      )
      (Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
 -> Either (TryFromException NodeUri NodeUriHex) NodeUriHex)
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
-> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
forall a b. (a -> b) -> a -> b
$ forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom @NodePubKey @NodePubKeyHex (NodePubKey
 -> Either
      (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex)
-> NodePubKey
-> Either (TryFromException NodePubKey NodePubKeyHex) NodePubKeyHex
forall a b. (a -> b) -> a -> b
$
        NodeUri -> NodePubKey
nodeUriPubKey NodeUri
src
    where
      sock :: SocketAddress
sock = NodeUri -> SocketAddress
nodeUriSocketAddress NodeUri
src
      host :: HostName
host = SocketAddress -> HostName
socketAddressHost SocketAddress
sock
      port :: PortNumber
port = SocketAddress -> PortNumber
socketAddressPort SocketAddress
sock

newtype RHashHex = RHashHex
  { RHashHex -> Text
unRHashHex :: Text
  }
  deriving newtype
    ( RHashHex -> RHashHex -> Bool
(RHashHex -> RHashHex -> Bool)
-> (RHashHex -> RHashHex -> Bool) -> Eq RHashHex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RHashHex -> RHashHex -> Bool
$c/= :: RHashHex -> RHashHex -> Bool
== :: RHashHex -> RHashHex -> Bool
$c== :: RHashHex -> RHashHex -> Bool
Eq,
      Eq RHashHex
Eq RHashHex
-> (RHashHex -> RHashHex -> Ordering)
-> (RHashHex -> RHashHex -> Bool)
-> (RHashHex -> RHashHex -> Bool)
-> (RHashHex -> RHashHex -> Bool)
-> (RHashHex -> RHashHex -> Bool)
-> (RHashHex -> RHashHex -> RHashHex)
-> (RHashHex -> RHashHex -> RHashHex)
-> Ord RHashHex
RHashHex -> RHashHex -> Bool
RHashHex -> RHashHex -> Ordering
RHashHex -> RHashHex -> RHashHex
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 :: RHashHex -> RHashHex -> RHashHex
$cmin :: RHashHex -> RHashHex -> RHashHex
max :: RHashHex -> RHashHex -> RHashHex
$cmax :: RHashHex -> RHashHex -> RHashHex
>= :: RHashHex -> RHashHex -> Bool
$c>= :: RHashHex -> RHashHex -> Bool
> :: RHashHex -> RHashHex -> Bool
$c> :: RHashHex -> RHashHex -> Bool
<= :: RHashHex -> RHashHex -> Bool
$c<= :: RHashHex -> RHashHex -> Bool
< :: RHashHex -> RHashHex -> Bool
$c< :: RHashHex -> RHashHex -> Bool
compare :: RHashHex -> RHashHex -> Ordering
$ccompare :: RHashHex -> RHashHex -> Ordering
Ord,
      Int -> RHashHex -> ShowS
[RHashHex] -> ShowS
RHashHex -> HostName
(Int -> RHashHex -> ShowS)
-> (RHashHex -> HostName) -> ([RHashHex] -> ShowS) -> Show RHashHex
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [RHashHex] -> ShowS
$cshowList :: [RHashHex] -> ShowS
show :: RHashHex -> HostName
$cshow :: RHashHex -> HostName
showsPrec :: Int -> RHashHex -> ShowS
$cshowsPrec :: Int -> RHashHex -> ShowS
Show,
      ReadPrec [RHashHex]
ReadPrec RHashHex
Int -> ReadS RHashHex
ReadS [RHashHex]
(Int -> ReadS RHashHex)
-> ReadS [RHashHex]
-> ReadPrec RHashHex
-> ReadPrec [RHashHex]
-> Read RHashHex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RHashHex]
$creadListPrec :: ReadPrec [RHashHex]
readPrec :: ReadPrec RHashHex
$creadPrec :: ReadPrec RHashHex
readList :: ReadS [RHashHex]
$creadList :: ReadS [RHashHex]
readsPrec :: Int -> ReadS RHashHex
$creadsPrec :: Int -> ReadS RHashHex
Read,
      Text -> Maybe RHashHex
RHashHex -> Text
(Text -> Maybe RHashHex)
-> (RHashHex -> Text) -> PathPiece RHashHex
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
toPathPiece :: RHashHex -> Text
$ctoPathPiece :: RHashHex -> Text
fromPathPiece :: Text -> Maybe RHashHex
$cfromPathPiece :: Text -> Maybe RHashHex
PathPiece
    )
  deriving stock
    ( (forall x. RHashHex -> Rep RHashHex x)
-> (forall x. Rep RHashHex x -> RHashHex) -> Generic RHashHex
forall x. Rep RHashHex x -> RHashHex
forall x. RHashHex -> Rep RHashHex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RHashHex x -> RHashHex
$cfrom :: forall x. RHashHex -> Rep RHashHex x
Generic
    )

instance Out RHashHex

instance From RHashHex Text

instance From Text RHashHex

instance From RHash RHashHex where
  from :: RHash -> RHashHex
from =
    --
    -- NOTE : decodeUtf8 in general is unsafe
    -- but here we know that it will not fail
    -- because of B16
    --
    Text -> RHashHex
RHashHex
      (Text -> RHashHex) -> (RHash -> Text) -> RHash -> RHashHex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
      (ByteString -> Text) -> (RHash -> ByteString) -> RHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
      (ByteString -> ByteString)
-> (RHash -> ByteString) -> RHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RHash -> ByteString
coerce

instance From RHashHex RHash where
  from :: RHashHex -> RHash
from =
    --
    -- NOTE : this is not RFC 4648-compliant,
    -- using only for the practical purposes
    --
    ByteString -> RHash
RHash
      (ByteString -> RHash)
-> (RHashHex -> ByteString) -> RHashHex -> RHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.decodeLenient
      (ByteString -> ByteString)
-> (RHashHex -> ByteString) -> RHashHex -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
      (Text -> ByteString)
-> (RHashHex -> Text) -> RHashHex -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RHashHex -> Text
unRHashHex

newtype Uuid (tab :: Table) = Uuid
  { forall (tab :: Table). Uuid tab -> UUID
unUuid' :: UUID
  }
  deriving newtype
    ( Uuid tab -> Uuid tab -> Bool
(Uuid tab -> Uuid tab -> Bool)
-> (Uuid tab -> Uuid tab -> Bool) -> Eq (Uuid tab)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
/= :: Uuid tab -> Uuid tab -> Bool
$c/= :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
== :: Uuid tab -> Uuid tab -> Bool
$c== :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
Eq,
      Eq (Uuid tab)
Eq (Uuid tab)
-> (Uuid tab -> Uuid tab -> Ordering)
-> (Uuid tab -> Uuid tab -> Bool)
-> (Uuid tab -> Uuid tab -> Bool)
-> (Uuid tab -> Uuid tab -> Bool)
-> (Uuid tab -> Uuid tab -> Bool)
-> (Uuid tab -> Uuid tab -> Uuid tab)
-> (Uuid tab -> Uuid tab -> Uuid tab)
-> Ord (Uuid tab)
Uuid tab -> Uuid tab -> Bool
Uuid tab -> Uuid tab -> Ordering
Uuid tab -> Uuid tab -> Uuid tab
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 (tab :: Table). Eq (Uuid tab)
forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
forall (tab :: Table). Uuid tab -> Uuid tab -> Ordering
forall (tab :: Table). Uuid tab -> Uuid tab -> Uuid tab
min :: Uuid tab -> Uuid tab -> Uuid tab
$cmin :: forall (tab :: Table). Uuid tab -> Uuid tab -> Uuid tab
max :: Uuid tab -> Uuid tab -> Uuid tab
$cmax :: forall (tab :: Table). Uuid tab -> Uuid tab -> Uuid tab
>= :: Uuid tab -> Uuid tab -> Bool
$c>= :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
> :: Uuid tab -> Uuid tab -> Bool
$c> :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
<= :: Uuid tab -> Uuid tab -> Bool
$c<= :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
< :: Uuid tab -> Uuid tab -> Bool
$c< :: forall (tab :: Table). Uuid tab -> Uuid tab -> Bool
compare :: Uuid tab -> Uuid tab -> Ordering
$ccompare :: forall (tab :: Table). Uuid tab -> Uuid tab -> Ordering
Ord,
      Int -> Uuid tab -> ShowS
[Uuid tab] -> ShowS
Uuid tab -> HostName
(Int -> Uuid tab -> ShowS)
-> (Uuid tab -> HostName)
-> ([Uuid tab] -> ShowS)
-> Show (Uuid tab)
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
forall (tab :: Table). Int -> Uuid tab -> ShowS
forall (tab :: Table). [Uuid tab] -> ShowS
forall (tab :: Table). Uuid tab -> HostName
showList :: [Uuid tab] -> ShowS
$cshowList :: forall (tab :: Table). [Uuid tab] -> ShowS
show :: Uuid tab -> HostName
$cshow :: forall (tab :: Table). Uuid tab -> HostName
showsPrec :: Int -> Uuid tab -> ShowS
$cshowsPrec :: forall (tab :: Table). Int -> Uuid tab -> ShowS
Show,
      ReadPrec [Uuid tab]
ReadPrec (Uuid tab)
Int -> ReadS (Uuid tab)
ReadS [Uuid tab]
(Int -> ReadS (Uuid tab))
-> ReadS [Uuid tab]
-> ReadPrec (Uuid tab)
-> ReadPrec [Uuid tab]
-> Read (Uuid tab)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (tab :: Table). ReadPrec [Uuid tab]
forall (tab :: Table). ReadPrec (Uuid tab)
forall (tab :: Table). Int -> ReadS (Uuid tab)
forall (tab :: Table). ReadS [Uuid tab]
readListPrec :: ReadPrec [Uuid tab]
$creadListPrec :: forall (tab :: Table). ReadPrec [Uuid tab]
readPrec :: ReadPrec (Uuid tab)
$creadPrec :: forall (tab :: Table). ReadPrec (Uuid tab)
readList :: ReadS [Uuid tab]
$creadList :: forall (tab :: Table). ReadS [Uuid tab]
readsPrec :: Int -> ReadS (Uuid tab)
$creadsPrec :: forall (tab :: Table). Int -> ReadS (Uuid tab)
Read
    )
  deriving stock ((forall x. Uuid tab -> Rep (Uuid tab) x)
-> (forall x. Rep (Uuid tab) x -> Uuid tab) -> Generic (Uuid tab)
forall x. Rep (Uuid tab) x -> Uuid tab
forall x. Uuid tab -> Rep (Uuid tab) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (tab :: Table) x. Rep (Uuid tab) x -> Uuid tab
forall (tab :: Table) x. Uuid tab -> Rep (Uuid tab) x
$cto :: forall (tab :: Table) x. Rep (Uuid tab) x -> Uuid tab
$cfrom :: forall (tab :: Table) x. Uuid tab -> Rep (Uuid tab) x
Generic)

unUuid :: Uuid tab -> UUID
unUuid :: forall (tab :: Table). Uuid tab -> UUID
unUuid =
  Uuid tab -> UUID
forall (tab :: Table). Uuid tab -> UUID
unUuid'

instance Out (Uuid tab) where
  docPrec :: Int -> Uuid tab -> Doc
docPrec Int
x =
    Int -> Text -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
x
      (Text -> Doc) -> (Uuid tab -> Text) -> Uuid tab -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
      (UUID -> Text) -> (Uuid tab -> UUID) -> Uuid tab -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uuid tab -> UUID
forall (tab :: Table). Uuid tab -> UUID
unUuid
  doc :: Uuid tab -> Doc
doc =
    Int -> Uuid tab -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
0

newUuid :: (MonadIO m) => m (Uuid tab)
newUuid :: forall (m :: * -> *) (tab :: Table). MonadIO m => m (Uuid tab)
newUuid =
  IO (Uuid tab) -> m (Uuid tab)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Uuid tab) -> m (Uuid tab)) -> IO (Uuid tab) -> m (Uuid tab)
forall a b. (a -> b) -> a -> b
$
    UUID -> Uuid tab
forall (tab :: Table). UUID -> Uuid tab
Uuid (UUID -> Uuid tab) -> IO UUID -> IO (Uuid tab)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom

newtype Vbyte = Vbyte
  { Vbyte -> Ratio Natural
unVbyte :: Ratio Natural
  }
  deriving newtype
    ( Vbyte -> Vbyte -> Bool
(Vbyte -> Vbyte -> Bool) -> (Vbyte -> Vbyte -> Bool) -> Eq Vbyte
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vbyte -> Vbyte -> Bool
$c/= :: Vbyte -> Vbyte -> Bool
== :: Vbyte -> Vbyte -> Bool
$c== :: Vbyte -> Vbyte -> Bool
Eq,
      Eq Vbyte
Eq Vbyte
-> (Vbyte -> Vbyte -> Ordering)
-> (Vbyte -> Vbyte -> Bool)
-> (Vbyte -> Vbyte -> Bool)
-> (Vbyte -> Vbyte -> Bool)
-> (Vbyte -> Vbyte -> Bool)
-> (Vbyte -> Vbyte -> Vbyte)
-> (Vbyte -> Vbyte -> Vbyte)
-> Ord Vbyte
Vbyte -> Vbyte -> Bool
Vbyte -> Vbyte -> Ordering
Vbyte -> Vbyte -> Vbyte
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 :: Vbyte -> Vbyte -> Vbyte
$cmin :: Vbyte -> Vbyte -> Vbyte
max :: Vbyte -> Vbyte -> Vbyte
$cmax :: Vbyte -> Vbyte -> Vbyte
>= :: Vbyte -> Vbyte -> Bool
$c>= :: Vbyte -> Vbyte -> Bool
> :: Vbyte -> Vbyte -> Bool
$c> :: Vbyte -> Vbyte -> Bool
<= :: Vbyte -> Vbyte -> Bool
$c<= :: Vbyte -> Vbyte -> Bool
< :: Vbyte -> Vbyte -> Bool
$c< :: Vbyte -> Vbyte -> Bool
compare :: Vbyte -> Vbyte -> Ordering
$ccompare :: Vbyte -> Vbyte -> Ordering
Ord,
      Int -> Vbyte -> ShowS
[Vbyte] -> ShowS
Vbyte -> HostName
(Int -> Vbyte -> ShowS)
-> (Vbyte -> HostName) -> ([Vbyte] -> ShowS) -> Show Vbyte
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Vbyte] -> ShowS
$cshowList :: [Vbyte] -> ShowS
show :: Vbyte -> HostName
$cshow :: Vbyte -> HostName
showsPrec :: Int -> Vbyte -> ShowS
$cshowsPrec :: Int -> Vbyte -> ShowS
Show,
      Integer -> Vbyte
Vbyte -> Vbyte
Vbyte -> Vbyte -> Vbyte
(Vbyte -> Vbyte -> Vbyte)
-> (Vbyte -> Vbyte -> Vbyte)
-> (Vbyte -> Vbyte -> Vbyte)
-> (Vbyte -> Vbyte)
-> (Vbyte -> Vbyte)
-> (Vbyte -> Vbyte)
-> (Integer -> Vbyte)
-> Num Vbyte
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Vbyte
$cfromInteger :: Integer -> Vbyte
signum :: Vbyte -> Vbyte
$csignum :: Vbyte -> Vbyte
abs :: Vbyte -> Vbyte
$cabs :: Vbyte -> Vbyte
negate :: Vbyte -> Vbyte
$cnegate :: Vbyte -> Vbyte
* :: Vbyte -> Vbyte -> Vbyte
$c* :: Vbyte -> Vbyte -> Vbyte
- :: Vbyte -> Vbyte -> Vbyte
$c- :: Vbyte -> Vbyte -> Vbyte
+ :: Vbyte -> Vbyte -> Vbyte
$c+ :: Vbyte -> Vbyte -> Vbyte
Num
    )
  deriving stock
    ( (forall x. Vbyte -> Rep Vbyte x)
-> (forall x. Rep Vbyte x -> Vbyte) -> Generic Vbyte
forall x. Rep Vbyte x -> Vbyte
forall x. Vbyte -> Rep Vbyte x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vbyte x -> Vbyte
$cfrom :: forall x. Vbyte -> Rep Vbyte x
Generic
    )

instance Out Vbyte

instance From Vbyte (Ratio Natural)

instance From (Ratio Natural) Vbyte

newtype RowQty = RowQty
  { RowQty -> Int64
unRowQty :: Int64
  }
  deriving newtype
    ( RowQty -> RowQty -> Bool
(RowQty -> RowQty -> Bool)
-> (RowQty -> RowQty -> Bool) -> Eq RowQty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowQty -> RowQty -> Bool
$c/= :: RowQty -> RowQty -> Bool
== :: RowQty -> RowQty -> Bool
$c== :: RowQty -> RowQty -> Bool
Eq,
      Eq RowQty
Eq RowQty
-> (RowQty -> RowQty -> Ordering)
-> (RowQty -> RowQty -> Bool)
-> (RowQty -> RowQty -> Bool)
-> (RowQty -> RowQty -> Bool)
-> (RowQty -> RowQty -> Bool)
-> (RowQty -> RowQty -> RowQty)
-> (RowQty -> RowQty -> RowQty)
-> Ord RowQty
RowQty -> RowQty -> Bool
RowQty -> RowQty -> Ordering
RowQty -> RowQty -> RowQty
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 :: RowQty -> RowQty -> RowQty
$cmin :: RowQty -> RowQty -> RowQty
max :: RowQty -> RowQty -> RowQty
$cmax :: RowQty -> RowQty -> RowQty
>= :: RowQty -> RowQty -> Bool
$c>= :: RowQty -> RowQty -> Bool
> :: RowQty -> RowQty -> Bool
$c> :: RowQty -> RowQty -> Bool
<= :: RowQty -> RowQty -> Bool
$c<= :: RowQty -> RowQty -> Bool
< :: RowQty -> RowQty -> Bool
$c< :: RowQty -> RowQty -> Bool
compare :: RowQty -> RowQty -> Ordering
$ccompare :: RowQty -> RowQty -> Ordering
Ord,
      Int -> RowQty -> ShowS
[RowQty] -> ShowS
RowQty -> HostName
(Int -> RowQty -> ShowS)
-> (RowQty -> HostName) -> ([RowQty] -> ShowS) -> Show RowQty
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [RowQty] -> ShowS
$cshowList :: [RowQty] -> ShowS
show :: RowQty -> HostName
$cshow :: RowQty -> HostName
showsPrec :: Int -> RowQty -> ShowS
$cshowsPrec :: Int -> RowQty -> ShowS
Show
    )
  deriving stock
    ( (forall x. RowQty -> Rep RowQty x)
-> (forall x. Rep RowQty x -> RowQty) -> Generic RowQty
forall x. Rep RowQty x -> RowQty
forall x. RowQty -> Rep RowQty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowQty x -> RowQty
$cfrom :: forall x. RowQty -> Rep RowQty x
Generic
    )

instance Out RowQty

data PsbtUtxo = PsbtUtxo
  { PsbtUtxo -> OutPoint
getOutPoint :: OP.OutPoint,
    PsbtUtxo -> MSat
getAmt :: MSat,
    PsbtUtxo -> Maybe UtxoLockId
getLockId :: Maybe UtxoLockId
  }
  deriving stock (Int -> PsbtUtxo -> ShowS
[PsbtUtxo] -> ShowS
PsbtUtxo -> HostName
(Int -> PsbtUtxo -> ShowS)
-> (PsbtUtxo -> HostName) -> ([PsbtUtxo] -> ShowS) -> Show PsbtUtxo
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [PsbtUtxo] -> ShowS
$cshowList :: [PsbtUtxo] -> ShowS
show :: PsbtUtxo -> HostName
$cshow :: PsbtUtxo -> HostName
showsPrec :: Int -> PsbtUtxo -> ShowS
$cshowsPrec :: Int -> PsbtUtxo -> ShowS
Show, (forall x. PsbtUtxo -> Rep PsbtUtxo x)
-> (forall x. Rep PsbtUtxo x -> PsbtUtxo) -> Generic PsbtUtxo
forall x. Rep PsbtUtxo x -> PsbtUtxo
forall x. PsbtUtxo -> Rep PsbtUtxo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PsbtUtxo x -> PsbtUtxo
$cfrom :: forall x. PsbtUtxo -> Rep PsbtUtxo x
Generic)

instance Out PsbtUtxo

instance From RowQty Int64

instance From Int64 RowQty

instance From Int RowQty where
  from :: Int -> RowQty
from =
    forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Int64

--
-- NOTE :  we're taking advantage of
-- PostgreSQL understanding UUID values
--
instance Psql.PersistField (Uuid tab) where
  toPersistValue :: Uuid tab -> PersistValue
toPersistValue =
    LiteralType -> ByteString -> PersistValue
Psql.PersistLiteral_ LiteralType
Psql.Escaped
      (ByteString -> PersistValue)
-> (Uuid tab -> ByteString) -> Uuid tab -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes
      (UUID -> ByteString)
-> (Uuid tab -> UUID) -> Uuid tab -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uuid tab -> UUID
forall (tab :: Table). Uuid tab -> UUID
unUuid
  fromPersistValue :: PersistValue -> Either Text (Uuid tab)
fromPersistValue = \case
    Psql.PersistLiteral_ LiteralType
Psql.Escaped ByteString
x ->
      Either Text (Uuid tab)
-> (UUID -> Either Text (Uuid tab))
-> Maybe UUID
-> Either Text (Uuid tab)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ( Text -> Either Text (Uuid tab)
forall a b. a -> Either a b
Left (Text -> Either Text (Uuid tab)) -> Text -> Either Text (Uuid tab)
forall a b. (a -> b) -> a -> b
$
            Text
"Failed to deserialize a UUID, got literal: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Out a => a -> Text
inspectPlain ByteString
x
        )
        ( Uuid tab -> Either Text (Uuid tab)
forall a b. b -> Either a b
Right
            (Uuid tab -> Either Text (Uuid tab))
-> (UUID -> Uuid tab) -> UUID -> Either Text (Uuid tab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Uuid tab
forall (tab :: Table). UUID -> Uuid tab
Uuid
        )
        (Maybe UUID -> Either Text (Uuid tab))
-> Maybe UUID -> Either Text (Uuid tab)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
x
    PersistValue
failure ->
      Text -> Either Text (Uuid tab)
forall a b. a -> Either a b
Left (Text -> Either Text (Uuid tab)) -> Text -> Either Text (Uuid tab)
forall a b. (a -> b) -> a -> b
$
        Text
"Failed to deserialize a UUID, got: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistValue -> Text
forall a. Out a => a -> Text
inspectPlain PersistValue
failure

instance Psql.PersistFieldSql (Uuid tab) where
  sqlType :: Proxy (Uuid tab) -> SqlType
sqlType =
    SqlType -> Proxy (Uuid tab) -> SqlType
forall a b. a -> b -> a
const (SqlType -> Proxy (Uuid tab) -> SqlType)
-> SqlType -> Proxy (Uuid tab) -> SqlType
forall a b. (a -> b) -> a -> b
$
      Text -> SqlType
Psql.SqlOther Text
"uuid"

instance ToMessage (Uuid tab) where
  toMessage :: Uuid tab -> Text
toMessage =
    (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...")
      (Text -> Text) -> (Uuid tab -> Text) -> Uuid tab -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
5
      (Text -> Text) -> (Uuid tab -> Text) -> Uuid tab -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
      (UUID -> Text) -> (Uuid tab -> UUID) -> Uuid tab -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uuid tab -> UUID
forall (tab :: Table). Uuid tab -> UUID
unUuid

instance PathPiece (Uuid tab) where
  fromPathPiece :: Text -> Maybe (Uuid tab)
fromPathPiece =
    (UUID -> Uuid tab
forall (tab :: Table). UUID -> Uuid tab
Uuid (UUID -> Uuid tab) -> Maybe UUID -> Maybe (Uuid tab)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
      (Maybe UUID -> Maybe (Uuid tab))
-> (Text -> Maybe UUID) -> Text -> Maybe (Uuid tab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe UUID
UUID.fromText
  toPathPiece :: Uuid tab -> Text
toPathPiece =
    UUID -> Text
UUID.toText
      (UUID -> Text) -> (Uuid tab -> UUID) -> Uuid tab -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uuid tab -> UUID
forall (tab :: Table). Uuid tab -> UUID
unUuid

Psql.derivePersistField "LnInvoiceStatus"
Psql.derivePersistField "LnChanStatus"
Psql.derivePersistField "SwapStatus"
Psql.derivePersistField "BlkStatus"
Psql.derivePersistField "SwapUtxoStatus"
Psql.derivePersistField "Privacy"
Psql.derivePersistField "UtxoLockId"