-- | Hash of the block

module Blockfrost.Types.Shared.BlockHash
  where

import Data.Aeson (FromJSON, ToJSON)
import Data.Char (isDigit)
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)
import qualified Text.Read

newtype BlockHash = BlockHash Text
  deriving stock (BlockHash -> BlockHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHash -> BlockHash -> Bool
$c/= :: BlockHash -> BlockHash -> Bool
== :: BlockHash -> BlockHash -> Bool
$c== :: BlockHash -> BlockHash -> Bool
Eq, Eq BlockHash
BlockHash -> BlockHash -> Bool
BlockHash -> BlockHash -> Ordering
BlockHash -> BlockHash -> BlockHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockHash -> BlockHash -> BlockHash
$cmin :: BlockHash -> BlockHash -> BlockHash
max :: BlockHash -> BlockHash -> BlockHash
$cmax :: BlockHash -> BlockHash -> BlockHash
>= :: BlockHash -> BlockHash -> Bool
$c>= :: BlockHash -> BlockHash -> Bool
> :: BlockHash -> BlockHash -> Bool
$c> :: BlockHash -> BlockHash -> Bool
<= :: BlockHash -> BlockHash -> Bool
$c<= :: BlockHash -> BlockHash -> Bool
< :: BlockHash -> BlockHash -> Bool
$c< :: BlockHash -> BlockHash -> Bool
compare :: BlockHash -> BlockHash -> Ordering
$ccompare :: BlockHash -> BlockHash -> Ordering
Ord, Int -> BlockHash -> ShowS
[BlockHash] -> ShowS
BlockHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockHash] -> ShowS
$cshowList :: [BlockHash] -> ShowS
show :: BlockHash -> String
$cshow :: BlockHash -> String
showsPrec :: Int -> BlockHash -> ShowS
$cshowsPrec :: Int -> BlockHash -> ShowS
Show, forall x. Rep BlockHash x -> BlockHash
forall x. BlockHash -> Rep BlockHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockHash x -> BlockHash
$cfrom :: forall x. BlockHash -> Rep BlockHash x
Generic)
  deriving newtype (ByteString -> Either Text BlockHash
Text -> Either Text BlockHash
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text BlockHash
$cparseQueryParam :: Text -> Either Text BlockHash
parseHeader :: ByteString -> Either Text BlockHash
$cparseHeader :: ByteString -> Either Text BlockHash
parseUrlPiece :: Text -> Either Text BlockHash
$cparseUrlPiece :: Text -> Either Text BlockHash
FromHttpApiData, BlockHash -> ByteString
BlockHash -> Builder
BlockHash -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: BlockHash -> Text
$ctoQueryParam :: BlockHash -> Text
toHeader :: BlockHash -> ByteString
$ctoHeader :: BlockHash -> ByteString
toEncodedUrlPiece :: BlockHash -> Builder
$ctoEncodedUrlPiece :: BlockHash -> Builder
toUrlPiece :: BlockHash -> Text
$ctoUrlPiece :: BlockHash -> Text
ToHttpApiData, Value -> Parser [BlockHash]
Value -> Parser BlockHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BlockHash]
$cparseJSONList :: Value -> Parser [BlockHash]
parseJSON :: Value -> Parser BlockHash
$cparseJSON :: Value -> Parser BlockHash
FromJSON, [BlockHash] -> Encoding
[BlockHash] -> Value
BlockHash -> Encoding
BlockHash -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BlockHash] -> Encoding
$ctoEncodingList :: [BlockHash] -> Encoding
toJSONList :: [BlockHash] -> Value
$ctoJSONList :: [BlockHash] -> Value
toEncoding :: BlockHash -> Encoding
$ctoEncoding :: BlockHash -> Encoding
toJSON :: BlockHash -> Value
$ctoJSON :: BlockHash -> Value
ToJSON)

mkBlockHash :: Text -> BlockHash
mkBlockHash :: Text -> BlockHash
mkBlockHash = Text -> BlockHash
BlockHash

unBlockHash :: BlockHash -> Text
unBlockHash :: BlockHash -> Text
unBlockHash (BlockHash Text
a) = Text
a

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

instance ToCapture (Capture "block_hash" BlockHash) where
  toCapture :: Proxy (Capture "block_hash" BlockHash) -> DocCapture
toCapture Proxy (Capture "block_hash" BlockHash)
_ = String -> String -> DocCapture
DocCapture String
"block_hash" String
"Specific block hash"

instance ToSample BlockHash where
    toSamples :: Proxy BlockHash -> [(Text, BlockHash)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples
      [ BlockHash
"d0fa315687e99ccdc96b14cc2ea74a767405d64427b648c470731a9b69e4606e"
      , BlockHash
"38bc6efb92a830a0ed22a64f979d120d26483fd3c811f6622a8c62175f530878"
      , BlockHash
"f3258fcd8b975c061b4fcdcfcbb438807134d6961ec278c200151274893b6b7d"
      ]

instance ToCapture (Capture "hash_or_number" (Either Integer BlockHash)) where
  toCapture :: Proxy (Capture "hash_or_number" (Either Integer BlockHash))
-> DocCapture
toCapture Proxy (Capture "hash_or_number" (Either Integer BlockHash))
_ = String -> String -> DocCapture
DocCapture String
"hash_or_number" String
"Hash or number of the requested block."

instance {-# OVERLAPS #-} ToHttpApiData (Either Integer BlockHash) where
  toUrlPiece :: Either Integer BlockHash -> Text
toUrlPiece = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Text
Data.Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) BlockHash -> Text
unBlockHash

instance {-# OVERLAPS #-} FromHttpApiData (Either Integer BlockHash) where
  parseUrlPiece :: Text -> Either Text (Either Integer BlockHash)
parseUrlPiece Text
x | (Char -> Bool) -> Text -> Bool
Data.Text.all Char -> Bool
isDigit Text
x =
    case forall a. Read a => String -> Maybe a
Text.Read.readMaybe (Text -> String
Data.Text.unpack Text
x) of
        Maybe Integer
Nothing      -> forall a b. a -> Either a b
Left Text
"Unable to read block id"
        Just Integer
blockId -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Integer
blockId)
  parseUrlPiece Text
x | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Text -> BlockHash
BlockHash Text
x))