{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DeriveAnyClass           #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE PolyKinds                #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE StandaloneDeriving       #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies             #-}

module Ouroboros.Network.Protocol.BlockFetch.Type where

import Data.Kind (Type)
import Data.Singletons

import Network.TypedProtocol.Core

import Control.DeepSeq
import GHC.Generics
import Ouroboros.Network.Util.ShowProxy (ShowProxy (..))


-- | Range of blocks, defined by a lower and upper point, inclusive.
--
data ChainRange point = ChainRange !point !point
  deriving (Int -> ChainRange point -> ShowS
[ChainRange point] -> ShowS
ChainRange point -> String
(Int -> ChainRange point -> ShowS)
-> (ChainRange point -> String)
-> ([ChainRange point] -> ShowS)
-> Show (ChainRange point)
forall point. Show point => Int -> ChainRange point -> ShowS
forall point. Show point => [ChainRange point] -> ShowS
forall point. Show point => ChainRange point -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall point. Show point => Int -> ChainRange point -> ShowS
showsPrec :: Int -> ChainRange point -> ShowS
$cshow :: forall point. Show point => ChainRange point -> String
show :: ChainRange point -> String
$cshowList :: forall point. Show point => [ChainRange point] -> ShowS
showList :: [ChainRange point] -> ShowS
Show, ChainRange point -> ChainRange point -> Bool
(ChainRange point -> ChainRange point -> Bool)
-> (ChainRange point -> ChainRange point -> Bool)
-> Eq (ChainRange point)
forall point.
Eq point =>
ChainRange point -> ChainRange point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall point.
Eq point =>
ChainRange point -> ChainRange point -> Bool
== :: ChainRange point -> ChainRange point -> Bool
$c/= :: forall point.
Eq point =>
ChainRange point -> ChainRange point -> Bool
/= :: ChainRange point -> ChainRange point -> Bool
Eq, Eq (ChainRange point)
Eq (ChainRange point) =>
(ChainRange point -> ChainRange point -> Ordering)
-> (ChainRange point -> ChainRange point -> Bool)
-> (ChainRange point -> ChainRange point -> Bool)
-> (ChainRange point -> ChainRange point -> Bool)
-> (ChainRange point -> ChainRange point -> Bool)
-> (ChainRange point -> ChainRange point -> ChainRange point)
-> (ChainRange point -> ChainRange point -> ChainRange point)
-> Ord (ChainRange point)
ChainRange point -> ChainRange point -> Bool
ChainRange point -> ChainRange point -> Ordering
ChainRange point -> ChainRange point -> ChainRange point
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
forall point. Ord point => Eq (ChainRange point)
forall point.
Ord point =>
ChainRange point -> ChainRange point -> Bool
forall point.
Ord point =>
ChainRange point -> ChainRange point -> Ordering
forall point.
Ord point =>
ChainRange point -> ChainRange point -> ChainRange point
$ccompare :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> Ordering
compare :: ChainRange point -> ChainRange point -> Ordering
$c< :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> Bool
< :: ChainRange point -> ChainRange point -> Bool
$c<= :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> Bool
<= :: ChainRange point -> ChainRange point -> Bool
$c> :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> Bool
> :: ChainRange point -> ChainRange point -> Bool
$c>= :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> Bool
>= :: ChainRange point -> ChainRange point -> Bool
$cmax :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> ChainRange point
max :: ChainRange point -> ChainRange point -> ChainRange point
$cmin :: forall point.
Ord point =>
ChainRange point -> ChainRange point -> ChainRange point
min :: ChainRange point -> ChainRange point -> ChainRange point
Ord, (forall x. ChainRange point -> Rep (ChainRange point) x)
-> (forall x. Rep (ChainRange point) x -> ChainRange point)
-> Generic (ChainRange point)
forall x. Rep (ChainRange point) x -> ChainRange point
forall x. ChainRange point -> Rep (ChainRange point) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point x. Rep (ChainRange point) x -> ChainRange point
forall point x. ChainRange point -> Rep (ChainRange point) x
$cfrom :: forall point x. ChainRange point -> Rep (ChainRange point) x
from :: forall x. ChainRange point -> Rep (ChainRange point) x
$cto :: forall point x. Rep (ChainRange point) x -> ChainRange point
to :: forall x. Rep (ChainRange point) x -> ChainRange point
Generic, ChainRange point -> ()
(ChainRange point -> ()) -> NFData (ChainRange point)
forall point. NFData point => ChainRange point -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall point. NFData point => ChainRange point -> ()
rnf :: ChainRange point -> ()
NFData)

data BlockFetch block point where
  BFIdle      :: BlockFetch block point
  BFBusy      :: BlockFetch block point
  BFStreaming :: BlockFetch block point
  BFDone      :: BlockFetch block point

instance ShowProxy block => ShowProxy (BlockFetch block point) where
    showProxy :: Proxy (BlockFetch block point) -> String
showProxy Proxy (BlockFetch block point)
_ = String
"BlockFetch" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy block -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy block
forall {k} (t :: k). Proxy t
Proxy :: Proxy block)

type SingBlockFetch :: BlockFetch block point
                    -> Type
data SingBlockFetch k where
    SingBFIdle      :: SingBlockFetch BFIdle
    SingBFBusy      :: SingBlockFetch BFBusy
    SingBFStreaming :: SingBlockFetch BFStreaming
    SingBFDone      :: SingBlockFetch BFDone

deriving instance Show (SingBlockFetch k)

instance StateTokenI BFIdle      where stateToken :: StateToken 'BFIdle
stateToken = StateToken 'BFIdle
SingBlockFetch 'BFIdle
forall {k} {k} {block :: k} {point :: k}. SingBlockFetch 'BFIdle
SingBFIdle
instance StateTokenI BFBusy      where stateToken :: StateToken 'BFBusy
stateToken = StateToken 'BFBusy
SingBlockFetch 'BFBusy
forall {k} {k} {block :: k} {point :: k}. SingBlockFetch 'BFBusy
SingBFBusy
instance StateTokenI BFStreaming where stateToken :: StateToken 'BFStreaming
stateToken = StateToken 'BFStreaming
SingBlockFetch 'BFStreaming
forall {k} {k} {block :: k} {point :: k}.
SingBlockFetch 'BFStreaming
SingBFStreaming
instance StateTokenI BFDone      where stateToken :: StateToken 'BFDone
stateToken = StateToken 'BFDone
SingBlockFetch 'BFDone
forall {k} {k} {block :: k} {point :: k}. SingBlockFetch 'BFDone
SingBFDone

instance Protocol (BlockFetch block point) where

  data Message (BlockFetch block point) from to where
    -- | request range of blocks
    MsgRequestRange
      :: ChainRange point
      -> Message (BlockFetch block point) BFIdle BFBusy
    -- | start block streaming
    MsgStartBatch
      :: Message (BlockFetch block point) BFBusy BFStreaming
    -- | respond that there are no blocks
    MsgNoBlocks
      :: Message (BlockFetch block point) BFBusy BFIdle
    -- | stream a single block
    MsgBlock
      :: block
      -> Message (BlockFetch block point) BFStreaming BFStreaming
    -- | end of block streaming
    MsgBatchDone
      :: Message (BlockFetch block point) BFStreaming BFIdle

    -- | client termination message
    MsgClientDone
      :: Message (BlockFetch block point) BFIdle BFDone

  type StateAgency BFIdle      = ClientAgency
  type StateAgency BFBusy      = ServerAgency
  type StateAgency BFStreaming = ServerAgency
  type StateAgency BFDone      = NobodyAgency

  type StateToken = SingBlockFetch


instance ( NFData block
         , NFData point
         ) => NFData (Message (BlockFetch block point) from to) where
  rnf :: Message (BlockFetch block point) from to -> ()
rnf (MsgRequestRange ChainRange point
crp) = ChainRange point -> ()
forall a. NFData a => a -> ()
rnf ChainRange point
crp
  rnf Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgStartBatch         = ()
  rnf Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgNoBlocks           = ()
  rnf (MsgBlock block
b)          = block -> ()
forall a. NFData a => a -> ()
rnf block
b
  rnf Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgBatchDone          = ()
  rnf Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgClientDone         = ()

instance (Show block, Show point)
      => Show (Message (BlockFetch block point) from to) where
  show :: Message (BlockFetch block point) from to -> String
show (MsgRequestRange ChainRange point
range) = String
"MsgRequestRange " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ChainRange point -> String
forall a. Show a => a -> String
show ChainRange point
range
  show Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgStartBatch           = String
"MsgStartBatch"
  show (MsgBlock block
block)        = String
"MsgBlock " String -> ShowS
forall a. [a] -> [a] -> [a]
++ block -> String
forall a. Show a => a -> String
show block
block
  show Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgNoBlocks             = String
"MsgNoBlocks"
  show Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgBatchDone            = String
"MsgBatchDone"
  show Message (BlockFetch block point) from to
R:MessageBlockFetchfromto (*) (*) block point from to
MsgClientDone           = String
"MsgClientDone"