-- | Transforming 'TxSkelAnchor' into its Cardano counterpart
module Cooked.MockChain.GenerateTx.Anchor (toCardanoAnchor) where

import Cardano.Ledger.BaseTypes qualified as Cardano
import Cardano.Ledger.Conway.Core qualified as Conway
import Control.Monad.Catch
import Cooked.Skeleton.Anchor
import Data.Default
import Data.Functor
import Data.Maybe
import Data.Text qualified as Text
import GHC.IO.Unsafe
import Network.HTTP.Simple qualified as Network

-- | This function transforms a 'TxSkelAnchor' into its Cardano counterpart. If
-- the provided anchor does not provde a resolved page, it will be unsafely
-- fetched online, so use at your own discretion.
toCardanoAnchor :: TxSkelAnchor -> Cardano.Anchor
toCardanoAnchor :: TxSkelAnchor -> Anchor
toCardanoAnchor TxSkelAnchor
txSkelAnchor =
  Anchor -> Maybe Anchor -> Anchor
forall a. a -> Maybe a -> a
fromMaybe Anchor
forall a. Default a => a
def (Maybe Anchor -> Anchor) -> Maybe Anchor -> Anchor
forall a b. (a -> b) -> a -> b
$
    do
      ([Char]
url, Maybe ByteString
page) <- TxSkelAnchor
txSkelAnchor
      Url
anchorUrl <- Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
Cardano.textToUrl ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
url) ([Char] -> Text
Text.pack [Char]
url)
      (ByteString -> Anchor) -> Maybe ByteString -> Maybe Anchor
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Url -> SafeHash AnchorData -> Anchor
Cardano.Anchor Url
anchorUrl (SafeHash AnchorData -> Anchor)
-> (ByteString -> SafeHash AnchorData) -> ByteString -> Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
Conway.hashAnnotated (AnchorData -> SafeHash AnchorData)
-> (ByteString -> AnchorData) -> ByteString -> SafeHash AnchorData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AnchorData
Cardano.AnchorData) (Maybe ByteString -> Maybe Anchor)
-> Maybe ByteString -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
page of
        Just ByteString
resolvedPage -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
resolvedPage
        Maybe ByteString
Nothing ->
          -- WARNING: very unsafe and unreproducible
          IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO
            ( (HttpException -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
                (Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> (HttpException -> Maybe ByteString)
-> HttpException
-> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe ByteString
forall a. [Char] -> Maybe a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Maybe ByteString)
-> (HttpException -> [Char]) -> HttpException -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char]
"Error when parsing anchor " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
url [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" with error: ") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char])
-> (HttpException -> [Char]) -> HttpException -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> [Char]
show @Network.HttpException))
                (([Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
Network.parseRequest [Char]
url IO Request
-> (Request -> IO (Response ByteString))
-> IO (Response ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
Network.httpBS) IO (Response ByteString)
-> (Response ByteString -> Maybe ByteString)
-> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall a. Response a -> a
Network.getResponseBody)
            )