--
-- Data vault for metrics
--
--
-- Copyright © 2013-2014 Anchor Systems, Pty Ltd and Others
--
-- The code in this file, and the program it is a part of, is
-- made available to you by its authors as open source software:
-- you can redistribute it and/or modify it under the terms of
-- the 3-clause BSD licence.
--

{-# LANGUAGE OverloadedStrings #-}
module Vaultaire.Types.ContentsOperation
(
    ContentsOperation(..),
    SourceDict,
) where

import Control.Applicative ((<$>), (<*>))
import qualified Data.ByteString as S
import Data.Packer (getBytes, getWord64LE, getWord8, putBytes, putWord64LE,
                    putWord8, runPacking, tryUnpacking)
import Test.QuickCheck
import Vaultaire.Classes.WireFormat
import Vaultaire.Types.Address
import Vaultaire.Types.SourceDict (SourceDict)

data ContentsOperation = ContentsListRequest
                       | GenerateNewAddress
                       | UpdateSourceTag Address SourceDict
                       | RemoveSourceTag Address SourceDict
  deriving (Show, Eq)

instance WireFormat ContentsOperation where
    fromWire bs = flip tryUnpacking bs $ do
        header <- getWord8
        case header of
            0x0 -> return ContentsListRequest
            0x1 -> return GenerateNewAddress
            0x2 -> UpdateSourceTag <$> getAddr <*> getSourceDict
            0x3 -> RemoveSourceTag <$> getAddr <*> getSourceDict
            _   -> fail "Illegal op code"
      where
        getAddr = Address <$> getWord64LE
        getSourceDict = do
            len <- fromIntegral <$> getWord64LE
            fromWire <$> getBytes len >>= either (fail . show) return

    toWire op =
        case op of
            ContentsListRequest   -> "\x00"
            GenerateNewAddress    -> "\x01"
            UpdateSourceTag addr dict -> sourceOpToWire 0x2 addr dict
            RemoveSourceTag addr dict -> sourceOpToWire 0x3 addr dict
      where
        sourceOpToWire header (Address addr) dict =
            let dict_bytes = toWire dict in
            let dict_len = S.length dict_bytes in
            runPacking (17 + dict_len) $ do
                putWord8 header
                putWord64LE addr
                putWord64LE (fromIntegral dict_len)
                putBytes dict_bytes

instance Arbitrary ContentsOperation where
    arbitrary = oneof [ return ContentsListRequest
                      , return GenerateNewAddress
                      , UpdateSourceTag <$> arbitrary <*> arbitrary
                      , RemoveSourceTag <$> arbitrary <*> arbitrary ]
