{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Haskoin.Keys.Extended.Internal (
Fingerprint (..),
fingerprintToText,
textToFingerprint,
) where
import Control.DeepSeq (NFData)
import Control.Monad ((>=>))
import Data.Aeson (
FromJSON,
ToJSON,
parseJSON,
toJSON,
withText,
)
import Data.Binary (Binary (..))
import Data.Bytes.Get (getWord32be)
import Data.Bytes.Put (putWord32be)
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import qualified Data.Serialize as S
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Haskoin.Util (decodeHex, encodeHex)
import Text.Read (readEither, readPrec)
newtype Fingerprint = Fingerprint {Fingerprint -> Word32
unFingerprint :: Word32}
deriving (Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c== :: Fingerprint -> Fingerprint -> Bool
Eq, Eq Fingerprint
Eq Fingerprint
-> (Fingerprint -> Fingerprint -> Ordering)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Fingerprint)
-> (Fingerprint -> Fingerprint -> Fingerprint)
-> Ord Fingerprint
Fingerprint -> Fingerprint -> Bool
Fingerprint -> Fingerprint -> Ordering
Fingerprint -> Fingerprint -> Fingerprint
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 :: Fingerprint -> Fingerprint -> Fingerprint
$cmin :: Fingerprint -> Fingerprint -> Fingerprint
max :: Fingerprint -> Fingerprint -> Fingerprint
$cmax :: Fingerprint -> Fingerprint -> Fingerprint
>= :: Fingerprint -> Fingerprint -> Bool
$c>= :: Fingerprint -> Fingerprint -> Bool
> :: Fingerprint -> Fingerprint -> Bool
$c> :: Fingerprint -> Fingerprint -> Bool
<= :: Fingerprint -> Fingerprint -> Bool
$c<= :: Fingerprint -> Fingerprint -> Bool
< :: Fingerprint -> Fingerprint -> Bool
$c< :: Fingerprint -> Fingerprint -> Bool
compare :: Fingerprint -> Fingerprint -> Ordering
$ccompare :: Fingerprint -> Fingerprint -> Ordering
$cp1Ord :: Eq Fingerprint
Ord, Int -> Fingerprint -> Int
Fingerprint -> Int
(Int -> Fingerprint -> Int)
-> (Fingerprint -> Int) -> Hashable Fingerprint
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Fingerprint -> Int
$chash :: Fingerprint -> Int
hashWithSalt :: Int -> Fingerprint -> Int
$chashWithSalt :: Int -> Fingerprint -> Int
Hashable, Typeable, (forall x. Fingerprint -> Rep Fingerprint x)
-> (forall x. Rep Fingerprint x -> Fingerprint)
-> Generic Fingerprint
forall x. Rep Fingerprint x -> Fingerprint
forall x. Fingerprint -> Rep Fingerprint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fingerprint x -> Fingerprint
$cfrom :: forall x. Fingerprint -> Rep Fingerprint x
Generic, Fingerprint -> ()
(Fingerprint -> ()) -> NFData Fingerprint
forall a. (a -> ()) -> NFData a
rnf :: Fingerprint -> ()
$crnf :: Fingerprint -> ()
NFData)
fingerprintToText :: Fingerprint -> Text
fingerprintToText :: Fingerprint -> Text
fingerprintToText = ByteString -> Text
encodeHex (ByteString -> Text)
-> (Fingerprint -> ByteString) -> Fingerprint -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> ByteString
forall a. Serialize a => a -> ByteString
S.encode
textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint = Either String ByteString
-> (ByteString -> Either String ByteString)
-> Maybe ByteString
-> Either String ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Fingerprint: invalid hex") ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Maybe ByteString -> Either String ByteString)
-> (Text -> Maybe ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Either String ByteString)
-> (ByteString -> Either String Fingerprint)
-> Text
-> Either String Fingerprint
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String Fingerprint
forall a. Serialize a => ByteString -> Either String a
S.decode
instance Show Fingerprint where
show :: Fingerprint -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (Fingerprint -> String) -> Fingerprint -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Fingerprint -> Text) -> Fingerprint -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (Fingerprint -> ByteString) -> Fingerprint -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> ByteString
forall a. Serialize a => a -> ByteString
S.encode
instance Read Fingerprint where
readPrec :: ReadPrec Fingerprint
readPrec =
ReadPrec Text
forall a. Read a => ReadPrec a
readPrec
ReadPrec Text
-> (Text -> ReadPrec ByteString) -> ReadPrec ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadPrec ByteString
-> (ByteString -> ReadPrec ByteString)
-> Maybe ByteString
-> ReadPrec ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadPrec ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Fingerprint: invalid hex") ByteString -> ReadPrec ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> ReadPrec ByteString)
-> (Text -> Maybe ByteString) -> Text -> ReadPrec ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
ReadPrec ByteString
-> (ByteString -> ReadPrec Fingerprint) -> ReadPrec Fingerprint
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ReadPrec Fingerprint)
-> (Fingerprint -> ReadPrec Fingerprint)
-> Either String Fingerprint
-> ReadPrec Fingerprint
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ReadPrec Fingerprint
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadPrec Fingerprint)
-> ShowS -> String -> ReadPrec Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Fingerprint: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)) Fingerprint -> ReadPrec Fingerprint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Fingerprint -> ReadPrec Fingerprint)
-> (ByteString -> Either String Fingerprint)
-> ByteString
-> ReadPrec Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Fingerprint
forall a. Serialize a => ByteString -> Either String a
S.decode
instance IsString Fingerprint where
fromString :: String -> Fingerprint
fromString =
Fingerprint -> Either String Fingerprint -> Fingerprint
forall b a. b -> Either a b -> b
fromRight Fingerprint
forall a. a
decodeError
(Either String Fingerprint -> Fingerprint)
-> (String -> Either String Fingerprint) -> String -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Fingerprint
forall a. Serialize a => ByteString -> Either String a
S.decode
(ByteString -> Either String Fingerprint)
-> (String -> ByteString) -> String -> Either String Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
forall a. a
hexError
(Maybe ByteString -> ByteString)
-> (String -> Maybe ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
(Text -> Maybe ByteString)
-> (String -> Text) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
where
decodeError :: a
decodeError = String -> a
forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Unable to decode"
hexError :: a
hexError = String -> a
forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Invalid hex"
instance Serial Fingerprint where
serialize :: Fingerprint -> m ()
serialize = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be (Word32 -> m ()) -> (Fingerprint -> Word32) -> Fingerprint -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Word32
unFingerprint
deserialize :: m Fingerprint
deserialize = Word32 -> Fingerprint
Fingerprint (Word32 -> Fingerprint) -> m Word32 -> m Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
instance Binary Fingerprint where
put :: Fingerprint -> Put
put = Fingerprint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Fingerprint
get = Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Serialize Fingerprint where
put :: Putter Fingerprint
put = Putter Fingerprint
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Fingerprint
get = Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance FromJSON Fingerprint where
parseJSON :: Value -> Parser Fingerprint
parseJSON = String
-> (Text -> Parser Fingerprint) -> Value -> Parser Fingerprint
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Fingerprint" ((Text -> Parser Fingerprint) -> Value -> Parser Fingerprint)
-> (Text -> Parser Fingerprint) -> Value -> Parser Fingerprint
forall a b. (a -> b) -> a -> b
$ (String -> Parser Fingerprint)
-> (Fingerprint -> Parser Fingerprint)
-> Either String Fingerprint
-> Parser Fingerprint
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Fingerprint
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Fingerprint -> Parser Fingerprint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Fingerprint -> Parser Fingerprint)
-> (Text -> Either String Fingerprint)
-> Text
-> Parser Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Fingerprint
textToFingerprint
instance ToJSON Fingerprint where
toJSON :: Fingerprint -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Fingerprint -> Text) -> Fingerprint -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Text
fingerprintToText