-- | 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)

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

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

instance ToJSON ScriptHash where
  toJSON :: ScriptHash -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
unScriptHash
  toEncoding :: ScriptHash -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
unScriptHash
instance FromJSON ScriptHash where
  parseJSON :: Value -> Parser ScriptHash
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScriptHash
ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHashList] -> ShowS
$cshowList :: [ScriptHashList] -> ShowS
show :: ScriptHashList -> String
$cshow :: ScriptHashList -> String
showsPrec :: Int -> ScriptHashList -> ShowS
$cshowsPrec :: Int -> ScriptHashList -> ShowS
Show, ScriptHashList -> ScriptHashList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHashList -> ScriptHashList -> Bool
$c/= :: ScriptHashList -> ScriptHashList -> Bool
== :: ScriptHashList -> ScriptHashList -> Bool
$c== :: ScriptHashList -> ScriptHashList -> Bool
Eq, 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
$cto :: forall x. Rep ScriptHashList x -> ScriptHashList
$cfrom :: forall x. ScriptHashList -> Rep ScriptHashList x
Generic)

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

instance ToSample ScriptHash where
    toSamples :: Proxy ScriptHash -> [(Text, ScriptHash)]
toSamples Proxy ScriptHash
_ = forall a. [a] -> [(Text, a)]
samples forall a b. (a -> b) -> a -> b
$ 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."