{-# LANGUAGE TemplateHaskell #-}

module Hydra.NetworkVersions where

import Hydra.Prelude hiding (encodeUtf8)

import Control.Lens ((^.), (^?))
import Data.Aeson (Value (..), encode)
import Data.Aeson.Lens (key, nonNull, _Key)
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.Text (splitOn)
import Data.Text.Encoding (encodeUtf8)
import Data.Version (Version (..), showVersion)
import Hydra.Cardano.Api (TxId, deserialiseFromRawBytesHex)
import Hydra.Version (embeddedRevision, gitRevision, unknownVersion)
import Paths_hydra_node (version)

hydraNodeVersion :: Version
hydraNodeVersion :: Version
hydraNodeVersion =
  Version
version Version -> (Version -> Version) -> Version
forall a b. a -> (a -> b) -> b
& \(Version [Int]
semver [String]
_) -> [Int] -> [String] -> Version
Version [Int]
semver [String]
revision
 where
  revision :: [String]
revision =
    Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$
      Maybe String
embeddedRevision
        Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
gitRevision
        Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
forall a. a -> Maybe a
Just String
unknownVersion

networkVersions :: ByteString
networkVersions :: ByteString
networkVersions = $(makeRelativeToProject "./networks.json" >>= embedFile)

parseNetworkTxIds :: MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds :: forall (m :: * -> *). MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds Version
hydraVersion String
network = do
  case ByteString
networkVersions ByteString -> Getting (First Value) ByteString Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key (String
network String -> Getting Key String Key -> Key
forall s a. s -> Getting a s a -> a
^. Getting Key String Key
forall t. IsKey t => Iso' t Key
Iso' String Key
_Key) of
    Maybe Value
Nothing -> String -> m [TxId]
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [TxId]) -> String -> m [TxId]
forall a b. (a -> b) -> a -> b
$ String
"Unknown network: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. ToString a => a -> String
toString String
network
    Just Value
t -> Value -> m [TxId]
getLastTxId Value
t
 where
  getLastTxId :: Value -> m [TxId]
getLastTxId Value
t = do
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
"-" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
hydraVersion of
      [] -> String -> m [TxId]
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse hydra-node revision."
      (Text
rev : [Text]
_) -> do
        case Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
t ByteString -> Getting (First Value) ByteString Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text
rev Text -> Getting Key Text Key -> Key
forall s a. s -> Getting a s a -> a
^. Getting Key Text Key
forall t. IsKey t => Iso' t Key
Iso' Text Key
_Key) Getting (First Value) ByteString Value
-> ((Value -> Const (First Value) Value)
    -> Value -> Const (First Value) Value)
-> Getting (First Value) ByteString Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Value) Value)
-> Value -> Const (First Value) Value
Prism' Value Value
nonNull of
          Just (String Text
s) -> (Text -> m TxId) -> [Text] -> m [TxId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> m TxId
forall {a} {m :: * -> *}.
(SerialiseAsRawBytes a, MonadFail m) =>
Text -> m a
parseToTxId ([Text] -> m [TxId]) -> [Text] -> m [TxId]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
"," Text
s
          Maybe Value
_ -> String -> m [TxId]
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to find released hydra-node version in networks.json."

  parseToTxId :: Text -> m a
parseToTxId Text
textTxId = do
    case ByteString -> Either RawBytesHexError a
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (ByteString -> Either RawBytesHexError a)
-> ByteString -> Either RawBytesHexError a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
textTxId of
      Left RawBytesHexError
_ -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse string to TxId: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
textTxId
      Right a
txid -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txid