content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE ImportQualifiedPost #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE NoFieldSelectors #-}
  
  module Haskoin.Crypto.Keys.Extended.Internal
    ( Fingerprint (..),
      fingerprintToText,
      textToFingerprint,
    )
  where
  
  import Control.DeepSeq (NFData)
  import Control.Monad ((>=>))
  import Data.Aeson
    ( FromJSON (parseJSON),
      ToJSON (toEncoding, toJSON),
      withText,
    )
  import Data.Aeson.Encoding (text)
  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 Data.Serialize qualified as S
  import Data.String (IsString (..))
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Data.Typeable (Typeable)
  import Data.Word (Word32)
  import GHC.Generics (Generic)
  import Haskoin.Util.Helpers (decodeHex, encodeHex)
  import Text.Read (readEither, readPrec)
  
  -- | Fingerprint of parent
  newtype Fingerprint = Fingerprint {get :: Word32}
    deriving (Eq, Ord, Hashable, Typeable, Generic, NFData)
  
  fingerprintToText :: Fingerprint -> Text
  fingerprintToText = encodeHex . S.encode
  
  textToFingerprint :: Text -> Either String Fingerprint
  textToFingerprint =
    maybe (Left "Fingerprint: invalid hex") Right . decodeHex >=> S.decode
  
  instance Show Fingerprint where
    show = show . Text.unpack . encodeHex . S.encode
  
  instance Read Fingerprint where
    readPrec =
      readPrec
        >>= maybe (fail "Fingerprint: invalid hex") pure . decodeHex
        >>= either (fail . ("Fingerprint: " <>)) pure . S.decode
  
  instance IsString Fingerprint where
    fromString =
      fromRight decodeError
        . S.decode
        . fromMaybe hexError
        . decodeHex
        . Text.pack
      where
        decodeError = error "Fingerprint literal: Unable to decode"
        hexError = error "Fingerprint literal: Invalid hex"
  
  instance Serial Fingerprint where
    serialize = putWord32be . (.get)
    deserialize = Fingerprint <$> getWord32be
  
  instance Binary Fingerprint where
    put = serialize
    get = deserialize
  
  instance Serialize Fingerprint where
    put = serialize
    get = deserialize
  
  instance FromJSON Fingerprint where
    parseJSON = withText "Fingerprint" $ either fail pure . textToFingerprint
  
  instance ToJSON Fingerprint where
    toJSON = toJSON . fingerprintToText
    toEncoding = text . fingerprintToText
  