{-# LANGUAGE TemplateHaskell #-}

module BtcLsp.Data.Smart
  ( OnChainAddress,
    unsafeNewOnChainAddress,
    unOnChainAddress,
    newOnChainAddress,
    newOnChainAddressT,
  )
where

import BtcLsp.Class.Env
import BtcLsp.Data.Kind
import BtcLsp.Data.Type
import BtcLsp.Grpc.Orphan
import BtcLsp.Import.External
import qualified BtcLsp.Import.Psql as Psql
import qualified Data.Text as T
import qualified LndClient.Data.NewAddress as Lnd
import qualified Network.Bitcoin.Wallet as Btc
import qualified Proto.BtcLsp.Data.HighLevel as Proto
import qualified Proto.BtcLsp.Data.LowLevel as Proto
import qualified Witch

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

instance Out (OnChainAddress mrel)

instance From (OnChainAddress mrel) Text

instance From Lnd.NewAddressResponse (OnChainAddress 'Fund)

instance From Lnd.NewAddressResponse (OnChainAddress 'Gain)

instance From (OnChainAddress mrel) Proto.OnChainAddress where
  from :: OnChainAddress mrel -> OnChainAddress
from = OnChainAddress mrel -> OnChainAddress
forall proto through haskell.
(Message proto, HasField proto "val" through, From haskell through,
 'False ~ (haskell == through)) =>
haskell -> proto
intoProto

instance From (OnChainAddress 'Refund) Proto.RefundOnChainAddress where
  from :: OnChainAddress 'Refund -> RefundOnChainAddress
from = OnChainAddress 'Refund -> RefundOnChainAddress
forall proto through haskell.
(Message proto, HasField proto "val" through, From haskell through,
 'False ~ (haskell == through)) =>
haskell -> proto
intoProto

instance From (OnChainAddress 'Fund) Proto.FundOnChainAddress where
  from :: OnChainAddress 'Fund -> FundOnChainAddress
from = OnChainAddress 'Fund -> FundOnChainAddress
forall proto through haskell.
(Message proto, HasField proto "val" through, From haskell through,
 'False ~ (haskell == through)) =>
haskell -> proto
intoProto

unsafeNewOnChainAddress :: Text -> OnChainAddress mrel
unsafeNewOnChainAddress :: forall (mrel :: MoneyRelation). Text -> OnChainAddress mrel
unsafeNewOnChainAddress = Text -> OnChainAddress mrel
forall (mrel :: MoneyRelation). Text -> OnChainAddress mrel
OnChainAddress

unOnChainAddress :: OnChainAddress mrel -> Text
unOnChainAddress :: forall (mrel :: MoneyRelation). OnChainAddress mrel -> Text
unOnChainAddress = OnChainAddress mrel -> Text
forall (mrel :: MoneyRelation). OnChainAddress mrel -> Text
unOnChainAddress0

newOnChainAddress ::
  ( Env m
  ) =>
  UnsafeOnChainAddress mrel ->
  m (Either Failure (OnChainAddress mrel))
newOnChainAddress :: forall (m :: * -> *) (mrel :: MoneyRelation).
Env m =>
UnsafeOnChainAddress mrel
-> m (Either Failure (OnChainAddress mrel))
newOnChainAddress UnsafeOnChainAddress mrel
unsafeAddr = do
  Either Failure AddrInfo
eRes <- (Client -> Text -> IO AddrInfo)
-> ((Text -> IO AddrInfo) -> IO AddrInfo)
-> m (Either Failure AddrInfo)
forall (m :: * -> *) a b.
Env m =>
(Client -> a) -> (a -> IO b) -> m (Either Failure b)
withBtc Client -> Text -> IO AddrInfo
Btc.getAddrInfo ((Text -> IO AddrInfo) -> Text -> IO AddrInfo
forall a b. (a -> b) -> a -> b
$ Text
txtAddr)
  case Either Failure AddrInfo
eRes of
    Left e :: Failure
e@(FailureInt (FailurePrivate Text
txt)) ->
      if (Text
"Not a valid Bech32 or Base58 encoding" Text -> Text -> Bool
`T.isInfixOf` Text
txt)
        Bool -> Bool -> Bool
|| (Text
"Invalid checksum" Text -> Text -> Bool
`T.isInfixOf` Text
txt)
        then Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (OnChainAddress mrel)
 -> m (Either Failure (OnChainAddress mrel)))
-> (Failure -> Either Failure (OnChainAddress mrel))
-> Failure
-> m (Either Failure (OnChainAddress mrel))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure (OnChainAddress mrel)
forall a b. a -> Either a b
Left (Failure -> m (Either Failure (OnChainAddress mrel)))
-> Failure -> m (Either Failure (OnChainAddress mrel))
forall a b. (a -> b) -> a -> b
$ FailureInput -> Failure
FailureInp FailureInput
FailureNonValidAddr
        else do
          $(logTM) Severity
WarningS (LogStr -> m ()) -> (Text -> LogStr) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"newOnChainAddress unexpected private failure " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Failure -> Text
forall a. Out a => a -> Text
inspect Failure
e
          Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (OnChainAddress mrel)
 -> m (Either Failure (OnChainAddress mrel)))
-> Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall a b. (a -> b) -> a -> b
$ Failure -> Either Failure (OnChainAddress mrel)
forall a b. a -> Either a b
Left Failure
e
    Left Failure
e -> do
      $(logTM) Severity
WarningS (LogStr -> m ()) -> (Text -> LogStr) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
"newOnChainAddress unexpected failure " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Failure -> Text
forall a. Out a => a -> Text
inspect Failure
e
      Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (OnChainAddress mrel)
 -> m (Either Failure (OnChainAddress mrel)))
-> Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall a b. (a -> b) -> a -> b
$
        Failure -> Either Failure (OnChainAddress mrel)
forall a b. a -> Either a b
Left Failure
e
    Right AddrInfo
res ->
      Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (OnChainAddress mrel)
 -> m (Either Failure (OnChainAddress mrel)))
-> Either Failure (OnChainAddress mrel)
-> m (Either Failure (OnChainAddress mrel))
forall a b. (a -> b) -> a -> b
$
        if AddrInfo -> Bool
Btc.isWitness AddrInfo
res
          then OnChainAddress mrel -> Either Failure (OnChainAddress mrel)
forall a b. b -> Either a b
Right (OnChainAddress mrel -> Either Failure (OnChainAddress mrel))
-> OnChainAddress mrel -> Either Failure (OnChainAddress mrel)
forall a b. (a -> b) -> a -> b
$ Text -> OnChainAddress mrel
forall (mrel :: MoneyRelation). Text -> OnChainAddress mrel
OnChainAddress Text
txtAddr
          else Failure -> Either Failure (OnChainAddress mrel)
forall a b. a -> Either a b
Left (Failure -> Either Failure (OnChainAddress mrel))
-> Failure -> Either Failure (OnChainAddress mrel)
forall a b. (a -> b) -> a -> b
$ FailureInput -> Failure
FailureInp FailureInput
FailureNonSegwitAddr
  where
    txtAddr :: Text
txtAddr = UnsafeOnChainAddress mrel -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from UnsafeOnChainAddress mrel
unsafeAddr

newOnChainAddressT ::
  ( Env m
  ) =>
  UnsafeOnChainAddress mrel ->
  ExceptT Failure m (OnChainAddress mrel)
newOnChainAddressT :: forall (m :: * -> *) (mrel :: MoneyRelation).
Env m =>
UnsafeOnChainAddress mrel
-> ExceptT Failure m (OnChainAddress mrel)
newOnChainAddressT =
  m (Either Failure (OnChainAddress mrel))
-> ExceptT Failure m (OnChainAddress mrel)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Failure (OnChainAddress mrel))
 -> ExceptT Failure m (OnChainAddress mrel))
-> (UnsafeOnChainAddress mrel
    -> m (Either Failure (OnChainAddress mrel)))
-> UnsafeOnChainAddress mrel
-> ExceptT Failure m (OnChainAddress mrel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsafeOnChainAddress mrel
-> m (Either Failure (OnChainAddress mrel))
forall (m :: * -> *) (mrel :: MoneyRelation).
Env m =>
UnsafeOnChainAddress mrel
-> m (Either Failure (OnChainAddress mrel))
newOnChainAddress