-- | Datum Hash newtype

module Blockfrost.Types.Shared.DatumHash
  ( DatumHash (..)
  ) where

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

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

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

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

instance ToSample DatumHash where
    toSamples :: Proxy DatumHash -> [(Text, DatumHash)]
toSamples Proxy DatumHash
_ = [DatumHash] -> [(Text, DatumHash)]
forall a. [a] -> [(Text, a)]
samples ([DatumHash] -> [(Text, DatumHash)])
-> [DatumHash] -> [(Text, DatumHash)]
forall a b. (a -> b) -> a -> b
$ (Text -> DatumHash) -> [Text] -> [DatumHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> DatumHash
DatumHash
      [ Text
"5a595ce795815e81d22a1a522cf3987d546dc5bb016de61b002edd63a5413ec4"
      , Text
"923918e403bf43c34b4ef6b48eb2ee04babed17320d8d1b9ff9ad086e86f44ec"
      ]

instance ToCapture (Capture "datum_hash" DatumHash) where
  toCapture :: Proxy (Capture "datum_hash" DatumHash) -> DocCapture
toCapture Proxy (Capture "datum_hash" DatumHash)
_ = String -> String -> DocCapture
DocCapture String
"datum_hash" String
"Datum hash."