{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
module Ouroboros.Consensus.Util.Versioned (
    VersionDecoder (..)
  , VersionError (..)
  , Versioned (..)
  , decodeVersion
  , decodeVersionWithHook
  , decodeVersioned
  , encodeVersion
  , encodeVersioned
    -- * opaque
  , VersionNumber
  ) where

import qualified Codec.CBOR.Decoding as Dec
import           Codec.Serialise (Serialise (..))
import           Codec.Serialise.Decoding (Decoder, decodeWord8)
import           Codec.Serialise.Encoding (Encoding, encodeListLen, encodeWord8)
import           Control.Exception (Exception)
import           Data.Word (Word8)

import           Cardano.Binary (enforceSize)


newtype VersionNumber = VersionNumber Word8
  deriving newtype (VersionNumber -> VersionNumber -> Bool
(VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool) -> Eq VersionNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionNumber -> VersionNumber -> Bool
$c/= :: VersionNumber -> VersionNumber -> Bool
== :: VersionNumber -> VersionNumber -> Bool
$c== :: VersionNumber -> VersionNumber -> Bool
Eq, Eq VersionNumber
Eq VersionNumber
-> (VersionNumber -> VersionNumber -> Ordering)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> Ord VersionNumber
VersionNumber -> VersionNumber -> Bool
VersionNumber -> VersionNumber -> Ordering
VersionNumber -> VersionNumber -> VersionNumber
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 :: VersionNumber -> VersionNumber -> VersionNumber
$cmin :: VersionNumber -> VersionNumber -> VersionNumber
max :: VersionNumber -> VersionNumber -> VersionNumber
$cmax :: VersionNumber -> VersionNumber -> VersionNumber
>= :: VersionNumber -> VersionNumber -> Bool
$c>= :: VersionNumber -> VersionNumber -> Bool
> :: VersionNumber -> VersionNumber -> Bool
$c> :: VersionNumber -> VersionNumber -> Bool
<= :: VersionNumber -> VersionNumber -> Bool
$c<= :: VersionNumber -> VersionNumber -> Bool
< :: VersionNumber -> VersionNumber -> Bool
$c< :: VersionNumber -> VersionNumber -> Bool
compare :: VersionNumber -> VersionNumber -> Ordering
$ccompare :: VersionNumber -> VersionNumber -> Ordering
$cp1Ord :: Eq VersionNumber
Ord, Integer -> VersionNumber
VersionNumber -> VersionNumber
VersionNumber -> VersionNumber -> VersionNumber
(VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber)
-> (Integer -> VersionNumber)
-> Num VersionNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VersionNumber
$cfromInteger :: Integer -> VersionNumber
signum :: VersionNumber -> VersionNumber
$csignum :: VersionNumber -> VersionNumber
abs :: VersionNumber -> VersionNumber
$cabs :: VersionNumber -> VersionNumber
negate :: VersionNumber -> VersionNumber
$cnegate :: VersionNumber -> VersionNumber
* :: VersionNumber -> VersionNumber -> VersionNumber
$c* :: VersionNumber -> VersionNumber -> VersionNumber
- :: VersionNumber -> VersionNumber -> VersionNumber
$c- :: VersionNumber -> VersionNumber -> VersionNumber
+ :: VersionNumber -> VersionNumber -> VersionNumber
$c+ :: VersionNumber -> VersionNumber -> VersionNumber
Num, Int -> VersionNumber -> ShowS
[VersionNumber] -> ShowS
VersionNumber -> String
(Int -> VersionNumber -> ShowS)
-> (VersionNumber -> String)
-> ([VersionNumber] -> ShowS)
-> Show VersionNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionNumber] -> ShowS
$cshowList :: [VersionNumber] -> ShowS
show :: VersionNumber -> String
$cshow :: VersionNumber -> String
showsPrec :: Int -> VersionNumber -> ShowS
$cshowsPrec :: Int -> VersionNumber -> ShowS
Show)

instance Serialise VersionNumber where
  encode :: VersionNumber -> Encoding
encode (VersionNumber Word8
w) = Word8 -> Encoding
encodeWord8 Word8
w
  decode :: Decoder s VersionNumber
decode = Word8 -> VersionNumber
VersionNumber (Word8 -> VersionNumber)
-> Decoder s Word8 -> Decoder s VersionNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall s. Decoder s Word8
decodeWord8

data Versioned a = Versioned
  { Versioned a -> VersionNumber
versionNumber :: !VersionNumber
  , Versioned a -> a
versioned     :: !a
  } deriving (Versioned a -> Versioned a -> Bool
(Versioned a -> Versioned a -> Bool)
-> (Versioned a -> Versioned a -> Bool) -> Eq (Versioned a)
forall a. Eq a => Versioned a -> Versioned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Versioned a -> Versioned a -> Bool
$c/= :: forall a. Eq a => Versioned a -> Versioned a -> Bool
== :: Versioned a -> Versioned a -> Bool
$c== :: forall a. Eq a => Versioned a -> Versioned a -> Bool
Eq, Int -> Versioned a -> ShowS
[Versioned a] -> ShowS
Versioned a -> String
(Int -> Versioned a -> ShowS)
-> (Versioned a -> String)
-> ([Versioned a] -> ShowS)
-> Show (Versioned a)
forall a. Show a => Int -> Versioned a -> ShowS
forall a. Show a => [Versioned a] -> ShowS
forall a. Show a => Versioned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Versioned a] -> ShowS
$cshowList :: forall a. Show a => [Versioned a] -> ShowS
show :: Versioned a -> String
$cshow :: forall a. Show a => Versioned a -> String
showsPrec :: Int -> Versioned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Versioned a -> ShowS
Show)

data VersionError
  = IncompatibleVersion VersionNumber String
    -- ^ We cannot deserialise the version of the data with the given
    -- 'VersionNumber' because its data format is incompatible.
    --
    -- For example, the given format lacks data that was added in later
    -- version that cannot be reconstructed from scratch.
  | UnknownVersion VersionNumber
    -- ^ The given 'VersionNumber' is unknown and thus not supported.
  | MigrationFailed VersionNumber String
    -- ^ A migration from the given 'VersionNumber' failed. See 'Migrate'.
  deriving stock    (Int -> VersionError -> ShowS
[VersionError] -> ShowS
VersionError -> String
(Int -> VersionError -> ShowS)
-> (VersionError -> String)
-> ([VersionError] -> ShowS)
-> Show VersionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionError] -> ShowS
$cshowList :: [VersionError] -> ShowS
show :: VersionError -> String
$cshow :: VersionError -> String
showsPrec :: Int -> VersionError -> ShowS
$cshowsPrec :: Int -> VersionError -> ShowS
Show)
  deriving anyclass (Show VersionError
Typeable VersionError
Typeable VersionError
-> Show VersionError
-> (VersionError -> SomeException)
-> (SomeException -> Maybe VersionError)
-> (VersionError -> String)
-> Exception VersionError
SomeException -> Maybe VersionError
VersionError -> String
VersionError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: VersionError -> String
$cdisplayException :: VersionError -> String
fromException :: SomeException -> Maybe VersionError
$cfromException :: SomeException -> Maybe VersionError
toException :: VersionError -> SomeException
$ctoException :: VersionError -> SomeException
$cp2Exception :: Show VersionError
$cp1Exception :: Typeable VersionError
Exception)

-- | How to decode a version of a format.
data VersionDecoder a where
  -- | This version is incompatible, fail with 'IncompatibleVersion' and the
  -- given message.
  Incompatible :: String
               -> VersionDecoder a

  -- | Decode the version using the given 'Decoder'.
  Decode       :: (forall s. Decoder s a)
               -> VersionDecoder a

  -- | Decode an other format (@from@) and migrate from that. When migration
  -- fails, the version decoder will fail with @MigrationFailed@.
  Migrate      :: VersionDecoder from
               -> (from -> Either String to)
               -> VersionDecoder to

-- | Return a 'Decoder' for the given 'VersionDecoder'.
getVersionDecoder
  :: VersionNumber
  -> VersionDecoder a
  -> forall s. Decoder s a
getVersionDecoder :: VersionNumber -> VersionDecoder a -> forall s. Decoder s a
getVersionDecoder VersionNumber
vn = \case
    Incompatible String
msg     -> String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a) -> String -> Decoder s a
forall a b. (a -> b) -> a -> b
$ VersionError -> String
forall a. Show a => a -> String
show (VersionError -> String) -> VersionError -> String
forall a b. (a -> b) -> a -> b
$ VersionNumber -> String -> VersionError
IncompatibleVersion VersionNumber
vn String
msg
    Decode forall s. Decoder s a
dec           -> Decoder s a
forall s. Decoder s a
dec
    Migrate VersionDecoder from
vDec from -> Either String a
migrate -> do
      from
from <- VersionNumber -> VersionDecoder from -> forall s. Decoder s from
forall a.
VersionNumber -> VersionDecoder a -> forall s. Decoder s a
getVersionDecoder VersionNumber
vn VersionDecoder from
vDec
      case from -> Either String a
migrate from
from of
        Left String
msg -> String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a) -> String -> Decoder s a
forall a b. (a -> b) -> a -> b
$ VersionError -> String
forall a. Show a => a -> String
show (VersionError -> String) -> VersionError -> String
forall a b. (a -> b) -> a -> b
$ VersionNumber -> String -> VersionError
MigrationFailed VersionNumber
vn String
msg
        Right a
to -> a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
to

-- | Given a 'VersionNumber' and the encoding of an @a@, encode the
-- corresponding @'Versioned' a@. Use 'decodeVersion' to decode it.
encodeVersion
  :: VersionNumber
  -> Encoding
  -> Encoding
encodeVersion :: VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
vn Encoding
encodedA = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
    [ Word -> Encoding
encodeListLen Word
2
    , VersionNumber -> Encoding
forall a. Serialise a => a -> Encoding
encode VersionNumber
vn
    , Encoding
encodedA
    ]

-- | Decode a /versioned/ @a@ (encoded using 'encodeVersion' or
-- 'encodeVersioned').
--
-- The corresponding 'VersionDecoder' for the deserialised 'VersionNumber' is
-- looked up in the given list. The first match is used (using the semantics
-- of 'lookup'). When no match is found, a decoder that fails with
-- 'UnknownVersion' is returned.
decodeVersion
  :: [(VersionNumber, VersionDecoder a)]
  -> forall s. Decoder s a
decodeVersion :: [(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion [(VersionNumber, VersionDecoder a)]
versionDecoders =
    Versioned a -> a
forall a. Versioned a -> a
versioned (Versioned a -> a) -> Decoder s (Versioned a) -> Decoder s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(VersionNumber, VersionDecoder a)]
-> forall s. Decoder s (Versioned a)
forall a.
[(VersionNumber, VersionDecoder a)]
-> forall s. Decoder s (Versioned a)
decodeVersioned [(VersionNumber, VersionDecoder a)]
versionDecoders

-- | Same as 'decodeVersion', but with a hook that gets called in case the
-- encoding was not produced by a versioned encoder. This allows a transition
-- from non-versioned to versioned encodings.
--
-- Versioned encodings start with list length 2. Whenever the encoding starts
-- this way, this decoder will use the regular versioned decoder. When the
-- encoding starts differently, either with a different list length ('Just' as
-- argument) or with another token ('Nothing' as argument), the hook is called,
-- allowing the previous non-versioned decoder to try to decode the encoding.
--
-- Note that the hook should /not/ try to decode the list length /again/.
--
-- Note that this will not work if the previous encoding can start with list
-- length 2, as the new versioned decoder will be called in those cases, not the
-- hook.
decodeVersionWithHook
  :: forall a.
     (forall s. Maybe Int -> Decoder s a)
  -> [(VersionNumber, VersionDecoder a)]
  -> forall s. Decoder s a
decodeVersionWithHook :: (forall s. Maybe Int -> Decoder s a)
-> [(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersionWithHook forall s. Maybe Int -> Decoder s a
hook [(VersionNumber, VersionDecoder a)]
versionDecoders = do
    TokenType
tokenType <- Decoder s TokenType
forall s. Decoder s TokenType
Dec.peekTokenType

    if TokenType -> Bool
isListLen TokenType
tokenType then do
      Int
len <- Decoder s Int
forall s. Decoder s Int
Dec.decodeListLen
      case Int
len of
        Int
2 -> Decoder s a
forall s. Decoder s a
goVersioned
        Int
_ -> Maybe Int -> Decoder s a
forall s. Maybe Int -> Decoder s a
hook (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len)

    else
      Maybe Int -> Decoder s a
forall s. Maybe Int -> Decoder s a
hook Maybe Int
forall a. Maybe a
Nothing

  where
    isListLen :: Dec.TokenType -> Bool
    isListLen :: TokenType -> Bool
isListLen = \case
        TokenType
Dec.TypeListLen   -> Bool
True
        TokenType
Dec.TypeListLen64 -> Bool
True
        TokenType
_                 -> Bool
False

    goVersioned :: forall s. Decoder s a
    goVersioned :: Decoder s a
goVersioned = do
        VersionNumber
vn <- Decoder s VersionNumber
forall a s. Serialise a => Decoder s a
decode
        case VersionNumber
-> [(VersionNumber, VersionDecoder a)] -> Maybe (VersionDecoder a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VersionNumber
vn [(VersionNumber, VersionDecoder a)]
versionDecoders of
          Maybe (VersionDecoder a)
Nothing   -> String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a) -> String -> Decoder s a
forall a b. (a -> b) -> a -> b
$ VersionError -> String
forall a. Show a => a -> String
show (VersionError -> String) -> VersionError -> String
forall a b. (a -> b) -> a -> b
$ VersionNumber -> VersionError
UnknownVersion VersionNumber
vn
          Just VersionDecoder a
vDec -> VersionNumber -> VersionDecoder a -> forall s. Decoder s a
forall a.
VersionNumber -> VersionDecoder a -> forall s. Decoder s a
getVersionDecoder VersionNumber
vn VersionDecoder a
vDec

encodeVersioned
  :: (          a -> Encoding)
  -> (Versioned a -> Encoding)
encodeVersioned :: (a -> Encoding) -> Versioned a -> Encoding
encodeVersioned a -> Encoding
enc (Versioned VersionNumber
vn a
a) =
    VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
vn (a -> Encoding
enc a
a)

decodeVersioned
  :: [(VersionNumber, VersionDecoder a)]
  -> forall s. Decoder s (Versioned a)
decodeVersioned :: [(VersionNumber, VersionDecoder a)]
-> forall s. Decoder s (Versioned a)
decodeVersioned [(VersionNumber, VersionDecoder a)]
versionDecoders = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Versioned" Int
2
    VersionNumber
vn <- Decoder s VersionNumber
forall a s. Serialise a => Decoder s a
decode
    case VersionNumber
-> [(VersionNumber, VersionDecoder a)] -> Maybe (VersionDecoder a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VersionNumber
vn [(VersionNumber, VersionDecoder a)]
versionDecoders of
      Maybe (VersionDecoder a)
Nothing   -> String -> Decoder s (Versioned a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Versioned a))
-> String -> Decoder s (Versioned a)
forall a b. (a -> b) -> a -> b
$ VersionError -> String
forall a. Show a => a -> String
show (VersionError -> String) -> VersionError -> String
forall a b. (a -> b) -> a -> b
$ VersionNumber -> VersionError
UnknownVersion VersionNumber
vn
      Just VersionDecoder a
vDec -> VersionNumber -> a -> Versioned a
forall a. VersionNumber -> a -> Versioned a
Versioned VersionNumber
vn (a -> Versioned a) -> Decoder s a -> Decoder s (Versioned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionNumber -> VersionDecoder a -> forall s. Decoder s a
forall a.
VersionNumber -> VersionDecoder a -> forall s. Decoder s a
getVersionDecoder VersionNumber
vn VersionDecoder a
vDec