-- | Script Hash newtype

module Blockfrost.Types.Shared.ScriptHash
  ( ScriptHash (..)
  , ScriptHashList (..)
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), Value(..), (.=), (.:))
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text
import qualified Data.Vector
import GHC.Generics
import Servant.API (Capture, FromHttpApiData (..), ToHttpApiData (..))
import Servant.Docs (DocCapture (..), ToCapture (..), ToSample (..), samples, singleSample)

-- | Script Hash newtype
newtype ScriptHash = ScriptHash { ScriptHash -> Text
unScriptHash :: Text }
  deriving stock (Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> String
(Int -> ScriptHash -> ShowS)
-> (ScriptHash -> String)
-> ([ScriptHash] -> ShowS)
-> Show ScriptHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptHash -> ShowS
showsPrec :: Int -> ScriptHash -> ShowS
$cshow :: ScriptHash -> String
show :: ScriptHash -> String
$cshowList :: [ScriptHash] -> ShowS
showList :: [ScriptHash] -> ShowS
Show, ScriptHash -> ScriptHash -> Bool
(ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool) -> Eq ScriptHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
/= :: ScriptHash -> ScriptHash -> Bool
Eq, (forall x. ScriptHash -> Rep ScriptHash x)
-> (forall x. Rep ScriptHash x -> ScriptHash) -> Generic ScriptHash
forall x. Rep ScriptHash x -> ScriptHash
forall x. ScriptHash -> Rep ScriptHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptHash -> Rep ScriptHash x
from :: forall x. ScriptHash -> Rep ScriptHash x
$cto :: forall x. Rep ScriptHash x -> ScriptHash
to :: forall x. Rep ScriptHash x -> ScriptHash
Generic)
  deriving newtype (Text -> Either Text ScriptHash
ByteString -> Either Text ScriptHash
(Text -> Either Text ScriptHash)
-> (ByteString -> Either Text ScriptHash)
-> (Text -> Either Text ScriptHash)
-> FromHttpApiData ScriptHash
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text ScriptHash
parseUrlPiece :: Text -> Either Text ScriptHash
$cparseHeader :: ByteString -> Either Text ScriptHash
parseHeader :: ByteString -> Either Text ScriptHash
$cparseQueryParam :: Text -> Either Text ScriptHash
parseQueryParam :: Text -> Either Text ScriptHash
FromHttpApiData, ScriptHash -> Text
ScriptHash -> ByteString
ScriptHash -> Builder
(ScriptHash -> Text)
-> (ScriptHash -> Builder)
-> (ScriptHash -> ByteString)
-> (ScriptHash -> Text)
-> (ScriptHash -> Builder)
-> ToHttpApiData ScriptHash
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: ScriptHash -> Text
toUrlPiece :: ScriptHash -> Text
$ctoEncodedUrlPiece :: ScriptHash -> Builder
toEncodedUrlPiece :: ScriptHash -> Builder
$ctoHeader :: ScriptHash -> ByteString
toHeader :: ScriptHash -> ByteString
$ctoQueryParam :: ScriptHash -> Text
toQueryParam :: ScriptHash -> Text
$ctoEncodedQueryParam :: ScriptHash -> Builder
toEncodedQueryParam :: ScriptHash -> Builder
ToHttpApiData)

instance IsString ScriptHash where
  fromString :: String -> ScriptHash
fromString = Text -> ScriptHash
ScriptHash (Text -> ScriptHash) -> (String -> Text) -> String -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack

instance ToJSON ScriptHash where
  toJSON :: ScriptHash -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ScriptHash -> Text) -> ScriptHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
unScriptHash
  toEncoding :: ScriptHash -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (ScriptHash -> Text) -> ScriptHash -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
unScriptHash
instance FromJSON ScriptHash where
  parseJSON :: Value -> Parser ScriptHash
parseJSON = (Text -> ScriptHash) -> Parser Text -> Parser ScriptHash
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScriptHash
ScriptHash (Parser Text -> Parser ScriptHash)
-> (Value -> Parser Text) -> Value -> Parser ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Wrapper for list of ScriptHash-es, used by script list endpoint
newtype ScriptHashList = ScriptHashList { ScriptHashList -> [ScriptHash]
unScriptHashList :: [ScriptHash] }
  deriving stock (Int -> ScriptHashList -> ShowS
[ScriptHashList] -> ShowS
ScriptHashList -> String
(Int -> ScriptHashList -> ShowS)
-> (ScriptHashList -> String)
-> ([ScriptHashList] -> ShowS)
-> Show ScriptHashList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptHashList -> ShowS
showsPrec :: Int -> ScriptHashList -> ShowS
$cshow :: ScriptHashList -> String
show :: ScriptHashList -> String
$cshowList :: [ScriptHashList] -> ShowS
showList :: [ScriptHashList] -> ShowS
Show, ScriptHashList -> ScriptHashList -> Bool
(ScriptHashList -> ScriptHashList -> Bool)
-> (ScriptHashList -> ScriptHashList -> Bool) -> Eq ScriptHashList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptHashList -> ScriptHashList -> Bool
== :: ScriptHashList -> ScriptHashList -> Bool
$c/= :: ScriptHashList -> ScriptHashList -> Bool
/= :: ScriptHashList -> ScriptHashList -> Bool
Eq, (forall x. ScriptHashList -> Rep ScriptHashList x)
-> (forall x. Rep ScriptHashList x -> ScriptHashList)
-> Generic ScriptHashList
forall x. Rep ScriptHashList x -> ScriptHashList
forall x. ScriptHashList -> Rep ScriptHashList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptHashList -> Rep ScriptHashList x
from :: forall x. ScriptHashList -> Rep ScriptHashList x
$cto :: forall x. Rep ScriptHashList x -> ScriptHashList
to :: forall x. Rep ScriptHashList x -> ScriptHashList
Generic)

instance ToJSON ScriptHashList where
  toJSON :: ScriptHashList -> Value
toJSON =
      Array -> Value
Array
    (Array -> Value)
-> (ScriptHashList -> Array) -> ScriptHashList -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Data.Vector.fromList
    ([Value] -> Array)
-> (ScriptHashList -> [Value]) -> ScriptHashList -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash -> Value) -> [ScriptHash] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\ScriptHash
sh -> Object -> Value
Object (Key
"script_hash" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ScriptHash -> Text) -> ScriptHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
unScriptHash (ScriptHash -> Value) -> ScriptHash -> Value
forall a b. (a -> b) -> a -> b
$ ScriptHash
sh)))
    ([ScriptHash] -> [Value])
-> (ScriptHashList -> [ScriptHash]) -> ScriptHashList -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHashList -> [ScriptHash]
unScriptHashList
instance FromJSON ScriptHashList where
  parseJSON :: Value -> Parser ScriptHashList
parseJSON (Array Array
a) = [ScriptHash] -> ScriptHashList
ScriptHashList ([ScriptHash] -> ScriptHashList)
-> Parser [ScriptHash] -> Parser ScriptHashList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ScriptHash) -> [Value] -> Parser [ScriptHash]
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 Value -> Parser ScriptHash
forall a. FromJSON a => Value -> Parser a
parseJSON' (Array -> [Value]
forall a. Vector a -> [a]
Data.Vector.toList Array
a)
    where
      parseJSON' :: Value -> Parser a
parseJSON' (Object Object
b) = Object
b Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script_hash"
      parseJSON' Value
_          = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected type for ScriptHash"
  parseJSON Value
_         = String -> Parser ScriptHashList
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected array for [ScriptHash]"

instance ToSample ScriptHashList where
  toSamples :: Proxy ScriptHashList -> [(Text, ScriptHashList)]
toSamples = [(Text, ScriptHashList)]
-> Proxy ScriptHashList -> [(Text, ScriptHashList)]
forall a. a -> Proxy ScriptHashList -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, ScriptHashList)]
 -> Proxy ScriptHashList -> [(Text, ScriptHashList)])
-> [(Text, ScriptHashList)]
-> Proxy ScriptHashList
-> [(Text, ScriptHashList)]
forall a b. (a -> b) -> a -> b
$ ScriptHashList -> [(Text, ScriptHashList)]
forall a. a -> [(Text, a)]
singleSample (ScriptHashList -> [(Text, ScriptHashList)])
-> ScriptHashList -> [(Text, ScriptHashList)]
forall a b. (a -> b) -> a -> b
$ [ScriptHash] -> ScriptHashList
ScriptHashList ([ScriptHash] -> ScriptHashList) -> [ScriptHash] -> ScriptHashList
forall a b. (a -> b) -> a -> b
$ (Text -> ScriptHash) -> [Text] -> [ScriptHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ScriptHash
ScriptHash
    [ Text
"67f33146617a5e61936081db3b2117cbf59bd2123748f58ac9678656"
    , Text
"e1457a0c47dfb7a2f6b8fbb059bdceab163c05d34f195b87b9f2b30e"
    ]

instance ToSample ScriptHash where
  toSamples :: Proxy ScriptHash -> [(Text, ScriptHash)]
toSamples Proxy ScriptHash
_ = [ScriptHash] -> [(Text, ScriptHash)]
forall a. [a] -> [(Text, a)]
samples ([ScriptHash] -> [(Text, ScriptHash)])
-> [ScriptHash] -> [(Text, ScriptHash)]
forall a b. (a -> b) -> a -> b
$ (Text -> ScriptHash) -> [Text] -> [ScriptHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ScriptHash
ScriptHash
    [ Text
"67f33146617a5e61936081db3b2117cbf59bd2123748f58ac9678656"
    , Text
"e1457a0c47dfb7a2f6b8fbb059bdceab163c05d34f195b87b9f2b30e"
    ]

instance ToCapture (Capture "script_hash" ScriptHash) where
  toCapture :: Proxy (Capture "script_hash" ScriptHash) -> DocCapture
toCapture Proxy (Capture "script_hash" ScriptHash)
_ = String -> String -> DocCapture
DocCapture String
"script_hash" String
"Hash of the script."