{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.CanonicalState.Import where

import Cardano.Ledger.BaseTypes (
  EpochNo,
  SlotNo,
 )
import Cardano.Ledger.CanonicalState.Export (
  ExportCanonicalState (State),
 )
import Cardano.SCLS.Internal.Entry.ChunkEntry (ChunkEntry, decodeChunkEntry)
import Cardano.SCLS.Internal.Reader (withNamespacedDataHandle)
import Cardano.SCLS.NamespaceCodec (KnownNamespace (NamespaceEntry, NamespaceKey))
import Cardano.Types.Namespace (fromSymbol)
import Control.Monad.IO.Class (MonadIO)
import Data.Proxy (Proxy)
import GHC.IO.Handle (Handle)
import GHC.TypeLits (KnownSymbol)
import Streaming.Prelude (Of, Stream)
import qualified Streaming.Prelude as S

class KnownNamespace ns => ImportCanonicalNamespace era ns where
  importNamespaceEntries ::
    Monad m =>
    State era ->
    Stream (Of (ChunkEntry (NamespaceKey ns) (NamespaceEntry ns))) m () ->
    m (State era)

class ImportCanonicalState era where
  importCanonicalState ::
    FilePath ->
    EpochNo ->
    IO (SlotNo, State era)

importNamespaceFromHandle ::
  forall era v m.
  (KnownSymbol v, ImportCanonicalNamespace era v, MonadIO m, MonadFail m) =>
  Handle -> Proxy v -> State era -> m (State era)
importNamespaceFromHandle :: forall era (v :: Symbol) (m :: * -> *).
(KnownSymbol v, ImportCanonicalNamespace era v, MonadIO m,
 MonadFail m) =>
Handle -> Proxy v -> State era -> m (State era)
importNamespaceFromHandle Handle
h (Proxy v
p :: Proxy v) State era
nes =
  Handle
-> Namespace
-> (Stream
      (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
      m
      ()
    -> m (State era))
-> m (State era)
forall u (m :: * -> *) a.
(MemPack u, Typeable u, MonadIO m) =>
Handle -> Namespace -> (Stream (Of u) m () -> m a) -> m a
withNamespacedDataHandle Handle
h (Proxy v -> Namespace
forall (n :: Symbol). KnownSymbol n => Proxy n -> Namespace
fromSymbol Proxy v
p) ((Stream
    (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
    m
    ()
  -> m (State era))
 -> m (State era))
-> (Stream
      (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
      m
      ()
    -> m (State era))
-> m (State era)
forall a b. (a -> b) -> a -> b
$ \Stream
  (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
  m
  ()
s ->
    forall era (ns :: Symbol) (m :: * -> *).
(ImportCanonicalNamespace era ns, Monad m) =>
State era
-> Stream
     (Of (ChunkEntry (NamespaceKey ns) (NamespaceEntry ns))) m ()
-> m (State era)
importNamespaceEntries @era @v
      State era
nes
      ( (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes
 -> m (ChunkEntry (NamespaceKey v) (NamespaceEntry v)))
-> Stream
     (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
     m
     ()
-> Stream
     (Of (ChunkEntry (NamespaceKey v) (NamespaceEntry v))) m ()
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
S.mapM
          ( \ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes
e -> case Proxy v
-> ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes
-> Maybe (ChunkEntry (NamespaceKey v) (NamespaceEntry v))
forall (ns :: Symbol).
KnownNamespace ns =>
Proxy ns
-> ChunkEntry (ByteStringSized (NamespaceKeySize ns)) RawBytes
-> Maybe (ChunkEntry (NamespaceKey ns) (NamespaceEntry ns))
decodeChunkEntry Proxy v
p ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes
e of
              Just ChunkEntry (NamespaceKey v) (NamespaceEntry v)
chunkEntry -> ChunkEntry (NamespaceKey v) (NamespaceEntry v)
-> m (ChunkEntry (NamespaceKey v) (NamespaceEntry v))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChunkEntry (NamespaceKey v) (NamespaceEntry v)
chunkEntry
              Maybe (ChunkEntry (NamespaceKey v) (NamespaceEntry v))
Nothing -> String -> m (ChunkEntry (NamespaceKey v) (NamespaceEntry v))
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (ChunkEntry (NamespaceKey v) (NamespaceEntry v)))
-> String -> m (ChunkEntry (NamespaceKey v) (NamespaceEntry v))
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode chunk entry for namespace: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Namespace -> String
forall a. Show a => a -> String
show (Proxy v -> Namespace
forall (n :: Symbol). KnownSymbol n => Proxy n -> Namespace
fromSymbol Proxy v
p)
          )
          Stream
  (Of (ChunkEntry (ByteStringSized (NamespaceKeySize v)) RawBytes))
  m
  ()
s
      )