{-# LANGUAGE RankNTypes #-}

module Ouroboros.Network.Protocol.Handshake.Direct (pureHandshake) where

import Data.Map qualified as Map

import Ouroboros.Network.Protocol.Handshake.Version

-- | Pure computation which serves as a reference implementation of the
-- @'Handshake'@ protocol. Useful for testing
-- @'handshakeClientPeer'@ against @'handshakeServerPeer'@
-- using  @'connect'@
--
pureHandshake
  ::forall vNumber vData r. Ord vNumber
  => (vData -> vData -> Maybe vData)
  -> Versions vNumber vData r -- reponders's \/ server's known versions
  -> Versions vNumber vData r -- initiator's \/ client's known versions
  -> (Maybe r, Maybe r)
pureHandshake :: forall vNumber vData r.
Ord vNumber =>
(vData -> vData -> Maybe vData)
-> Versions vNumber vData r
-> Versions vNumber vData r
-> (Maybe r, Maybe r)
pureHandshake vData -> vData -> Maybe vData
acceptVersion (Versions Map vNumber (Version vData r)
serverVersions) (Versions Map vNumber (Version vData r)
clientVersions) =

      case Map vNumber (Version vData r) -> [(vNumber, Version vData r)]
forall k a. Map k a -> [(k, a)]
Map.toDescList (Map vNumber (Version vData r) -> [(vNumber, Version vData r)])
-> Map vNumber (Version vData r) -> [(vNumber, Version vData r)]
forall a b. (a -> b) -> a -> b
$ Map vNumber (Version vData r)
serverVersions Map vNumber (Version vData r)
-> Map vNumber (Version vData r) -> Map vNumber (Version vData r)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map vNumber (Version vData r)
clientVersions of

        []             -> (Maybe r
forall a. Maybe a
Nothing, Maybe r
forall a. Maybe a
Nothing)

        (vNumber
vNumber, Version vData r
_):[(vNumber, Version vData r)]
_ ->
          case (Map vNumber (Version vData r)
serverVersions Map vNumber (Version vData r) -> vNumber -> Version vData r
forall k a. Ord k => Map k a -> k -> a
Map.! vNumber
vNumber, Map vNumber (Version vData r)
clientVersions Map vNumber (Version vData r) -> vNumber -> Version vData r
forall k a. Ord k => Map k a -> k -> a
Map.! vNumber
vNumber) of
            ( Version vData r
version, Version vData r
version' ) ->
                ( Version vData r -> vData -> r
forall vData r. Version vData r -> vData -> r
versionApplication Version vData r
version
                    (vData -> r) -> Maybe vData -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vData -> vData -> Maybe vData
acceptVersion (Version vData r -> vData
forall vData r. Version vData r -> vData
versionData Version vData r
version)  (Version vData r -> vData
forall vData r. Version vData r -> vData
versionData Version vData r
version')
                , Version vData r -> vData -> r
forall vData r. Version vData r -> vData -> r
versionApplication Version vData r
version'
                    (vData -> r) -> Maybe vData -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vData -> vData -> Maybe vData
acceptVersion (Version vData r -> vData
forall vData r. Version vData r -> vData
versionData Version vData r
version') (Version vData r -> vData
forall vData r. Version vData r -> vData
versionData Version vData r
version)
                )