{-# 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
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
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
Ord, Eq Fingerprint
Int -> Fingerprint -> Int
Fingerprint -> Int
forall a. Eq 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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Fingerprint -> ()
$crnf :: Fingerprint -> ()
NFData)
fingerprintToText :: Fingerprint -> Text
fingerprintToText :: Fingerprint -> Text
fingerprintToText = ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode
textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint :: Text -> Either String Fingerprint
textToFingerprint = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"Fingerprint: invalid hex") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. Serialize a => ByteString -> Either String a
S.decode
instance Show Fingerprint where
show :: Fingerprint -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
S.encode
instance Read Fingerprint where
readPrec :: ReadPrec Fingerprint
readPrec =
forall a. Read a => ReadPrec a
readPrec
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Fingerprint: invalid hex") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Fingerprint: " forall a. Semigroup a => a -> a -> a
<>)) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
S.decode
instance IsString Fingerprint where
fromString :: String -> Fingerprint
fromString =
forall b a. b -> Either a b -> b
fromRight forall {a}. a
decodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
S.decode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
hexError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
where
decodeError :: a
decodeError = forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Unable to decode"
hexError :: a
hexError = forall a. HasCallStack => String -> a
error String
"Fingerprint literal: Invalid hex"
instance Serial Fingerprint where
serialize :: forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize = forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Word32
unFingerprint
deserialize :: forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize = Word32 -> Fingerprint
Fingerprint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word32
getWord32be
instance Binary Fingerprint where
put :: Fingerprint -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Fingerprint
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Serialize Fingerprint where
put :: Putter Fingerprint
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Fingerprint
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance FromJSON Fingerprint where
parseJSON :: Value -> Parser Fingerprint
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Fingerprint" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Fingerprint
textToFingerprint
instance ToJSON Fingerprint where
toJSON :: Fingerprint -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Text
fingerprintToText