{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module BtcLsp.Yesod.Handler.OpenChan where

import BtcLsp.Class.Env
import BtcLsp.Yesod.Import

getOpenChanR :: Handler Html
getOpenChanR :: Handler Html
getOpenChanR = do
  App {appMRunner :: ()
appMRunner = UnliftIO forall a. m a -> IO a
run} <- HandlerFor App App
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
  NodeUri
nodeUri <- IO NodeUri -> HandlerFor App NodeUri
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NodeUri -> HandlerFor App NodeUri)
-> IO NodeUri -> HandlerFor App NodeUri
forall a b. (a -> b) -> a -> b
$ m NodeUri -> IO NodeUri
forall a. m a -> IO a
run m NodeUri
forall (m :: * -> *). Env m => m NodeUri
getLndNodeUri
  Text
nodeUriHex <-
    (TryFromException NodeUri NodeUriHex -> HandlerFor App Text)
-> (NodeUriHex -> HandlerFor App Text)
-> HandlerFor
     App (Either (TryFromException NodeUri NodeUriHex) NodeUriHex)
-> HandlerFor App Text
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM
      (HandlerFor App Text
-> TryFromException NodeUri NodeUriHex -> HandlerFor App Text
forall a b. a -> b -> a
const HandlerFor App Text
forall (m :: * -> *) a. MonadHandler m => m a
badMethod)
      (Text -> HandlerFor App Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HandlerFor App Text)
-> (NodeUriHex -> Text) -> NodeUriHex -> HandlerFor App Text
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from @NodeUriHex @Text)
      (HandlerFor
   App (Either (TryFromException NodeUri NodeUriHex) NodeUriHex)
 -> HandlerFor App Text)
-> (Either (TryFromException NodeUri NodeUriHex) NodeUriHex
    -> HandlerFor
         App (Either (TryFromException NodeUri NodeUriHex) NodeUriHex))
-> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
-> HandlerFor App Text
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either (TryFromException NodeUri NodeUriHex) NodeUriHex
-> HandlerFor
     App (Either (TryFromException NodeUri NodeUriHex) NodeUriHex)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Either (TryFromException NodeUri NodeUriHex) NodeUriHex
 -> HandlerFor App Text)
-> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
-> HandlerFor App Text
forall a b. (a -> b) -> a -> b
$ NodeUri -> Either (TryFromException NodeUri NodeUriHex) NodeUriHex
forall source target.
(TryFrom source target, 'False ~ (source == target)) =>
source -> Either (TryFromException source target) target
tryFrom NodeUri
nodeUri
  Text
qrCodeSrc <-
    HandlerFor App Text
-> (Text -> HandlerFor App Text)
-> HandlerFor App (Maybe Text)
-> HandlerFor App Text
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM HandlerFor App Text
forall (m :: * -> *) a. MonadHandler m => m a
badMethod Text -> HandlerFor App Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (HandlerFor App (Maybe Text) -> HandlerFor App Text)
-> (Maybe Text -> HandlerFor App (Maybe Text))
-> Maybe Text
-> HandlerFor App Text
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Text -> HandlerFor App (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe Text -> HandlerFor App Text)
-> Maybe Text -> HandlerFor App Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
toQr Text
nodeUriHex
  BootstrapColor
-> AppMessage -> AppMessage -> Widget -> Handler Html
panelLayout BootstrapColor
Info AppMessage
MsgOpenChanRLinkLong AppMessage
MsgOpenChanInstruction (Widget -> Handler Html) -> Widget -> Handler Html
forall a b. (a -> b) -> a -> b
$ do
    AppMessage -> Widget
forall (m :: * -> *) msg.
(MonadWidget m, RenderMessage (HandlerSite m) msg) =>
msg -> m ()
setTitleI AppMessage
MsgOpenChanRTitle
    $(widgetFile "open_chan")
  where
    htmlUuid :: Text
htmlUuid = $(mkHtmlUuid)