content: {-# LANGUAGE RecordWildCards #-}
  
  module Pos.Core.Common.AddrAttributes
         ( AddrAttributes (..)
         ) where
  
  import           Universum
  
  import qualified Data.ByteString.Lazy as LBS
  import           Data.SafeCopy (SafeCopy (..), contain, safeGet, safePut)
  import qualified Data.Serialize as Cereal
  import           Formatting (bprint, build, builder, (%))
  import qualified Formatting.Buildable as Buildable
  
  import           Pos.Binary.Class (Bi, decode, encode)
  import qualified Pos.Binary.Class as Bi
  import           Pos.Core.Attributes (Attributes (..), decodeAttributes,
                       encodeAttributes, mkAttributes)
  import           Pos.Core.NetworkMagic (NetworkMagic (..))
  import           Pos.Crypto.HD (HDAddressPayload)
  
  import           Pos.Core.Common.AddrStakeDistribution
  
  -- | Additional information stored along with address. It's intended
  -- to be put into 'Attributes' data type to make it extensible with
  -- softfork.
  data AddrAttributes = AddrAttributes
      { aaPkDerivationPath  :: !(Maybe HDAddressPayload)
      , aaStakeDistribution :: !AddrStakeDistribution
      , aaNetworkMagic      :: !NetworkMagic
      } deriving (Eq, Ord, Show, Generic, Typeable)
  
  instance Buildable AddrAttributes where
      build (AddrAttributes {..}) =
          bprint
              ("AddrAttributes { stake distribution: "%build%
               ", derivation path: "%builder%
               ", aaNetworkMagic: "%build%" }")
              aaStakeDistribution
              derivationPathBuilder
              aaNetworkMagic
        where
          derivationPathBuilder =
              case aaPkDerivationPath of
                  Nothing -> "{}"
                  Just _  -> "{path is encrypted}"
  
  instance NFData AddrAttributes
  
  {- NOTE: Address attributes serialization
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  'Attributes' are conceptually a map, where keys are numbers ('Word8').
  
  For address there are two attributes:
  • 0 — stake distribution, defaults to 'BootstrapEraDistr';
  • 1 — derivation path, defaults to 'Nothing'.
  
  -}
  
  instance Bi (Attributes AddrAttributes) where
      -- FIXME @avieth it was observed that for a 150kb block, this call to
      -- encodeAttributes allocated 3.685mb
      -- Try using serialize rather than serialize', to avoid the
      -- toStrict call.
      -- Also consider using a custom builder strategy; serialized attributes are
      -- probably small, right?
      encode attrs@(Attributes {attrData = AddrAttributes derivationPath stakeDistr networkMagic}) =
          encodeAttributes listWithIndices attrs
        where
          listWithIndices :: [(Word8, AddrAttributes -> LBS.ByteString)]
          listWithIndices = stakeDistributionListWithIndices
                         <> derivationPathListWithIndices
                         <> networkMagicListWithIndices
  
          stakeDistributionListWithIndices =
              case stakeDistr of
                  BootstrapEraDistr -> []
                  _                 -> [(0, Bi.serialize . aaStakeDistribution)]
          derivationPathListWithIndices =
              case derivationPath of
                  Nothing -> []
                  -- 'unsafeFromJust' is safe, because 'case' ensures
                  -- that derivation path is 'Just'.
                  Just _ ->
                      [(1, Bi.serialize . unsafeFromJust . aaPkDerivationPath)]
  
          networkMagicListWithIndices =
              case networkMagic of
                  NetworkMainOrStage -> []
                  NetworkTestnet x  ->
                      [(2, \_ -> Bi.serialize x)]
  
          unsafeFromJust =
              fromMaybe
                  (error "Maybe was Nothing in Bi (Attributes AddrAttributes)")
  
      decode = decodeAttributes initValue go
        where
          initValue =
              AddrAttributes
              { aaPkDerivationPath = Nothing
              , aaStakeDistribution = BootstrapEraDistr
              , aaNetworkMagic = NetworkMainOrStage
              }
          go n v acc =
              case n of
                  0 -> (\distr -> Just $ acc {aaStakeDistribution = distr }    ) <$> Bi.deserialize v
                  1 -> (\deriv -> Just $ acc {aaPkDerivationPath = Just deriv }) <$> Bi.deserialize v
                  2 -> (\deriv -> Just $ acc {aaNetworkMagic = NetworkTestnet deriv }    ) <$> Bi.deserialize v
                  _ -> pure Nothing
  
  instance SafeCopy AddrAttributes where
      -- Since there is only a Bi instance for (Attributes AddrAttributes),
      -- we wrap our AddrAttributes before we serialize it.
      putCopy aa = contain $ do
          let bs = Bi.serialize (mkAttributes aa)
          safePut bs
       -- Try decoding as a BSL.ByteString containing the new format, but if that
      -- fails go for the legacy format.
      getCopy = contain $ label $ getNonLegacy <|> getLegacy
        where
          label = Cereal.label "Pos.Core.Common.AddrAttributes.AddrAttributes:"
          --
          getNonLegacy = do
              eAAA <- Bi.decodeFull <$> safeGet
              case eAAA of
                  Left  err -> fail (show err)
                  Right aaa -> pure (attrData aaa)
          --
          getLegacy = AddrAttributes <$> safeGet
                                     <*> safeGet
                                     <*> pure NetworkMainOrStage
  