{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeOperators              #-}

module Ouroboros.Network.Protocol.Handshake.Version
  ( Versions (..)
  , Version (..)
  , VersionMismatch (..)
    -- * Simple or no versioning
  , simpleSingletonVersions
  , foldMapVersions
  , combineVersions
    -- * Re-exports
  , Accept (..)
  , Acceptable (..)
  , Queryable (..)
  ) where

import           Data.Foldable (toList)
import           Data.Map (Map)
import qualified Data.Map as Map
import           GHC.Stack (HasCallStack)

import           Ouroboros.Network.Handshake.Acceptable (Accept (..),
                     Acceptable (..))
import           Ouroboros.Network.Handshake.Queryable (Queryable (..))


-- | The version map supported by the local agent keyed on the version
-- identifier.
--
-- Each 'Version' contains a function which takes negotiated version data and
-- returns negotiated application (the 'r' type variable).
--
-- If one needs to combine multiple versions the simplest way is to use one of
-- the combinators: 'foldMapVersions', 'combineVersions' or the 'Semigroup'
-- instance directly:
--
-- >
-- > fold $ (simpleSingletonVersions ...)
-- >       :| [ (simpleSingletonVersions ...)
-- >          , (simpleSingletonVersions ...)
-- >          , ...
-- >          ]
-- >
--
newtype Versions vNum vData r = Versions
  { forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions :: Map vNum (Version vData r)
  }
  deriving NonEmpty (Versions vNum vData r) -> Versions vNum vData r
Versions vNum vData r
-> Versions vNum vData r -> Versions vNum vData r
forall b.
Integral b =>
b -> Versions vNum vData r -> Versions vNum vData r
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall vNum vData r.
Ord vNum =>
NonEmpty (Versions vNum vData r) -> Versions vNum vData r
forall vNum vData r.
Ord vNum =>
Versions vNum vData r
-> Versions vNum vData r -> Versions vNum vData r
forall vNum vData r b.
(Ord vNum, Integral b) =>
b -> Versions vNum vData r -> Versions vNum vData r
stimes :: forall b.
Integral b =>
b -> Versions vNum vData r -> Versions vNum vData r
$cstimes :: forall vNum vData r b.
(Ord vNum, Integral b) =>
b -> Versions vNum vData r -> Versions vNum vData r
sconcat :: NonEmpty (Versions vNum vData r) -> Versions vNum vData r
$csconcat :: forall vNum vData r.
Ord vNum =>
NonEmpty (Versions vNum vData r) -> Versions vNum vData r
<> :: Versions vNum vData r
-> Versions vNum vData r -> Versions vNum vData r
$c<> :: forall vNum vData r.
Ord vNum =>
Versions vNum vData r
-> Versions vNum vData r -> Versions vNum vData r
Semigroup

instance Functor (Versions vNum extra) where
    fmap :: forall a b.
(a -> b) -> Versions vNum extra a -> Versions vNum extra b
fmap a -> b
f (Versions Map vNum (Version extra a)
vs) = forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)  Map vNum (Version extra a)
vs


-- | Useful for folding multiple 'Versions'.
--
-- A 'foldMap' restricted to the 'Versions' 'Semigroup'.
--
-- PRECONDITION: @f x@ is non-empty.
--
foldMapVersions :: (Ord vNum, Foldable f, HasCallStack)
                => (x -> Versions vNum extra r)
                -> f x
                -> Versions vNum extra r
foldMapVersions :: forall vNum (f :: * -> *) x extra r.
(Ord vNum, Foldable f, HasCallStack) =>
(x -> Versions vNum extra r) -> f x -> Versions vNum extra r
foldMapVersions x -> Versions vNum extra r
f f x
fx = case forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f x
fx of
    [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"foldMapVersions: precondition violated"
    [x]
xs -> forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Semigroup a => a -> a -> a
(<>) (forall a b. (a -> b) -> [a] -> [b]
map x -> Versions vNum extra r
f [x]
xs)

combineVersions :: (Ord vNum, Foldable f, HasCallStack)
                => f (Versions vNum extra r)
                -> Versions vNum extra r
combineVersions :: forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions = forall vNum (f :: * -> *) x extra r.
(Ord vNum, Foldable f, HasCallStack) =>
(x -> Versions vNum extra r) -> f x -> Versions vNum extra r
foldMapVersions forall a. a -> a
id


data Version vData r = Version
  { forall vData r. Version vData r -> vData -> r
versionApplication :: vData -> r
  , forall vData r. Version vData r -> vData
versionData        :: vData
  }
  deriving forall a b. a -> Version vData b -> Version vData a
forall a b. (a -> b) -> Version vData a -> Version vData b
forall vData a b. a -> Version vData b -> Version vData a
forall vData a b. (a -> b) -> Version vData a -> Version vData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Version vData b -> Version vData a
$c<$ :: forall vData a b. a -> Version vData b -> Version vData a
fmap :: forall a b. (a -> b) -> Version vData a -> Version vData b
$cfmap :: forall vData a b. (a -> b) -> Version vData a -> Version vData b
Functor

data VersionMismatch vNum where
  NoCommonVersion     :: VersionMismatch vNum
  InconsistentVersion :: vNum -> VersionMismatch vNum

--
-- Simple version negotiation
--

-- | Singleton smart constructor for 'Versions'.
--
simpleSingletonVersions
  :: vNum
  -> vData
  -> r
  -> Versions vNum vData r
simpleSingletonVersions :: forall vNum vData r. vNum -> vData -> r -> Versions vNum vData r
simpleSingletonVersions vNum
vNum vData
vData r
r =
  forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions
    forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton vNum
vNum
      (forall vData r. (vData -> r) -> vData -> Version vData r
Version (\vData
_ -> r
r) vData
vData)