-- | 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
(BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool) -> Eq BlockHash
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
Eq BlockHash
-> (BlockHash -> BlockHash -> Ordering)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> BlockHash)
-> (BlockHash -> BlockHash -> BlockHash)
-> Ord 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
$cp1Ord :: Eq BlockHash
Ord, Int -> BlockHash -> ShowS
[BlockHash] -> ShowS
BlockHash -> String
(Int -> BlockHash -> ShowS)
-> (BlockHash -> String)
-> ([BlockHash] -> ShowS)
-> Show BlockHash
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. BlockHash -> Rep BlockHash x)
-> (forall x. Rep BlockHash x -> BlockHash) -> Generic BlockHash
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
(Text -> Either Text BlockHash)
-> (ByteString -> Either Text BlockHash)
-> (Text -> Either Text BlockHash)
-> FromHttpApiData 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
(BlockHash -> Text)
-> (BlockHash -> Builder)
-> (BlockHash -> ByteString)
-> (BlockHash -> Text)
-> ToHttpApiData BlockHash
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
(Value -> Parser BlockHash)
-> (Value -> Parser [BlockHash]) -> FromJSON 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
(BlockHash -> Value)
-> (BlockHash -> Encoding)
-> ([BlockHash] -> Value)
-> ([BlockHash] -> Encoding)
-> ToJSON BlockHash
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 (Text -> BlockHash) -> (String -> Text) -> String -> BlockHash
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 = [(Text, BlockHash)] -> Proxy BlockHash -> [(Text, BlockHash)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, BlockHash)] -> Proxy BlockHash -> [(Text, BlockHash)])
-> [(Text, BlockHash)] -> Proxy BlockHash -> [(Text, BlockHash)]
forall a b. (a -> b) -> a -> b
$ [BlockHash] -> [(Text, BlockHash)]
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 = (Integer -> Text)
-> (BlockHash -> Text) -> Either Integer BlockHash -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Text
Data.Text.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
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 String -> Maybe Integer
forall a. Read a => String -> Maybe a
Text.Read.readMaybe (Text -> String
Data.Text.unpack Text
x) of
        Maybe Integer
Nothing      -> Text -> Either Text (Either Integer BlockHash)
forall a b. a -> Either a b
Left Text
"Unable to read block id"
        Just Integer
blockId -> Either Integer BlockHash -> Either Text (Either Integer BlockHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either Integer BlockHash
forall a b. a -> Either a b
Left Integer
blockId)
  parseUrlPiece Text
x | Bool
otherwise = Either Integer BlockHash -> Either Text (Either Integer BlockHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockHash -> Either Integer BlockHash
forall a b. b -> Either a b
Right (Text -> BlockHash
BlockHash Text
x))