{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util (
    -- * Utilities
    Two (..)
  , checkChecksum
  , dbFilesOnDisk
  , fsPathChunkFile
  , fsPathPrimaryIndexFile
  , fsPathSecondaryIndexFile
  , parseDBFile
  , removeFilesStartingFrom
  , renderFile
  , runGet
  , runGetWithUnconsumed
  , tryImmutableDB
  , wrapFsError
  ) where

import           Control.Monad (forM_)
import           Data.Binary.Get (Get)
import qualified Data.Binary.Get as Get
import qualified Data.ByteString.Lazy as Lazy
import           Data.List as List (foldl')
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Typeable (Typeable)
import           Ouroboros.Consensus.Block hiding (hashSize)
import           Ouroboros.Consensus.Storage.ImmutableDB.API
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
                     (ChunkNo (..))
import           Ouroboros.Consensus.Util.CallStack
import           Ouroboros.Consensus.Util.IOLike
import           System.FS.API
import           System.FS.CRC
import           Text.Read (readMaybe)

{------------------------------------------------------------------------------
  Utilities
------------------------------------------------------------------------------}

-- | Useful when you have exactly two values of some type and want to
-- 'traverse' over both of them (which is not possible with a tuple).
data Two a = Two a a
  deriving ((forall a b. (a -> b) -> Two a -> Two b)
-> (forall a b. a -> Two b -> Two a) -> Functor Two
forall a b. a -> Two b -> Two a
forall a b. (a -> b) -> Two a -> Two b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Two a -> Two b
fmap :: forall a b. (a -> b) -> Two a -> Two b
$c<$ :: forall a b. a -> Two b -> Two a
<$ :: forall a b. a -> Two b -> Two a
Functor, (forall m. Monoid m => Two m -> m)
-> (forall m a. Monoid m => (a -> m) -> Two a -> m)
-> (forall m a. Monoid m => (a -> m) -> Two a -> m)
-> (forall a b. (a -> b -> b) -> b -> Two a -> b)
-> (forall a b. (a -> b -> b) -> b -> Two a -> b)
-> (forall b a. (b -> a -> b) -> b -> Two a -> b)
-> (forall b a. (b -> a -> b) -> b -> Two a -> b)
-> (forall a. (a -> a -> a) -> Two a -> a)
-> (forall a. (a -> a -> a) -> Two a -> a)
-> (forall a. Two a -> [a])
-> (forall a. Two a -> Bool)
-> (forall a. Two a -> Int)
-> (forall a. Eq a => a -> Two a -> Bool)
-> (forall a. Ord a => Two a -> a)
-> (forall a. Ord a => Two a -> a)
-> (forall a. Num a => Two a -> a)
-> (forall a. Num a => Two a -> a)
-> Foldable Two
forall a. Eq a => a -> Two a -> Bool
forall a. Num a => Two a -> a
forall a. Ord a => Two a -> a
forall m. Monoid m => Two m -> m
forall a. Two a -> Bool
forall a. Two a -> Int
forall a. Two a -> [a]
forall a. (a -> a -> a) -> Two a -> a
forall m a. Monoid m => (a -> m) -> Two a -> m
forall b a. (b -> a -> b) -> b -> Two a -> b
forall a b. (a -> b -> b) -> b -> Two a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Two m -> m
fold :: forall m. Monoid m => Two m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Two a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Two a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Two a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Two a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Two a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Two a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Two a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Two a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Two a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Two a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Two a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Two a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Two a -> a
foldr1 :: forall a. (a -> a -> a) -> Two a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Two a -> a
foldl1 :: forall a. (a -> a -> a) -> Two a -> a
$ctoList :: forall a. Two a -> [a]
toList :: forall a. Two a -> [a]
$cnull :: forall a. Two a -> Bool
null :: forall a. Two a -> Bool
$clength :: forall a. Two a -> Int
length :: forall a. Two a -> Int
$celem :: forall a. Eq a => a -> Two a -> Bool
elem :: forall a. Eq a => a -> Two a -> Bool
$cmaximum :: forall a. Ord a => Two a -> a
maximum :: forall a. Ord a => Two a -> a
$cminimum :: forall a. Ord a => Two a -> a
minimum :: forall a. Ord a => Two a -> a
$csum :: forall a. Num a => Two a -> a
sum :: forall a. Num a => Two a -> a
$cproduct :: forall a. Num a => Two a -> a
product :: forall a. Num a => Two a -> a
Foldable, Functor Two
Foldable Two
(Functor Two, Foldable Two) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Two a -> f (Two b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Two (f a) -> f (Two a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Two a -> m (Two b))
-> (forall (m :: * -> *) a. Monad m => Two (m a) -> m (Two a))
-> Traversable Two
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Two (m a) -> m (Two a)
forall (f :: * -> *) a. Applicative f => Two (f a) -> f (Two a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Two a -> m (Two b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Two a -> f (Two b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Two a -> f (Two b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Two a -> f (Two b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Two (f a) -> f (Two a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Two (f a) -> f (Two a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Two a -> m (Two b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Two a -> m (Two b)
$csequence :: forall (m :: * -> *) a. Monad m => Two (m a) -> m (Two a)
sequence :: forall (m :: * -> *) a. Monad m => Two (m a) -> m (Two a)
Traversable)

fsPathChunkFile :: ChunkNo -> FsPath
fsPathChunkFile :: ChunkNo -> FsPath
fsPathChunkFile = Text -> ChunkNo -> FsPath
renderFile Text
"chunk"

fsPathPrimaryIndexFile :: ChunkNo -> FsPath
fsPathPrimaryIndexFile :: ChunkNo -> FsPath
fsPathPrimaryIndexFile = Text -> ChunkNo -> FsPath
renderFile Text
"primary"

fsPathSecondaryIndexFile :: ChunkNo -> FsPath
fsPathSecondaryIndexFile :: ChunkNo -> FsPath
fsPathSecondaryIndexFile = Text -> ChunkNo -> FsPath
renderFile Text
"secondary"

-- | Opposite of 'parseDBFile'.
renderFile :: Text -> ChunkNo -> FsPath
renderFile :: Text -> ChunkNo -> FsPath
renderFile Text
fileType (ChunkNo Word64
chunk) = [Text] -> FsPath
fsPathFromList [Text
name]
  where
    name :: Text
name = Int -> Char -> Text -> Text
T.justifyRight Int
5 Char
'0' (String -> Text
T.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
chunk)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fileType

-- | Parse the prefix and chunk number from the filename of an index or chunk
-- file.
--
-- > parseDBFile "00001.chunk"
-- Just ("chunk", 1)
-- > parseDBFile "00012.primary"
-- Just ("primary", 12)
parseDBFile :: String -> Maybe (String, ChunkNo)
parseDBFile :: String -> Maybe (String, ChunkNo)
parseDBFile String
s = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
    [Text
n, Text
ext] -> (Text -> String
T.unpack Text
ext,) (ChunkNo -> (String, ChunkNo))
-> (Word64 -> ChunkNo) -> Word64 -> (String, ChunkNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ChunkNo
ChunkNo (Word64 -> (String, ChunkNo))
-> Maybe Word64 -> Maybe (String, ChunkNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
n)
    [Text]
_        -> Maybe (String, ChunkNo)
forall a. Maybe a
Nothing

-- | Go through all files, making three sets: the set of chunk files, primary
-- index files, and secondary index files, discarding all others.
dbFilesOnDisk :: Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
dbFilesOnDisk :: Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
dbFilesOnDisk = ((Set ChunkNo, Set ChunkNo, Set ChunkNo)
 -> String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo))
-> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
-> Set String
-> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Set ChunkNo, Set ChunkNo, Set ChunkNo)
-> String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
categorise (Set ChunkNo, Set ChunkNo, Set ChunkNo)
forall a. Monoid a => a
mempty
  where
    categorise :: (Set ChunkNo, Set ChunkNo, Set ChunkNo)
-> String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
categorise fs :: (Set ChunkNo, Set ChunkNo, Set ChunkNo)
fs@(!Set ChunkNo
chunk, !Set ChunkNo
primary, !Set ChunkNo
secondary) String
file =
      case String -> Maybe (String, ChunkNo)
parseDBFile String
file of
        Just (String
"chunk",     ChunkNo
n) -> (ChunkNo -> Set ChunkNo -> Set ChunkNo
forall a. Ord a => a -> Set a -> Set a
Set.insert ChunkNo
n Set ChunkNo
chunk, Set ChunkNo
primary, Set ChunkNo
secondary)
        Just (String
"primary",   ChunkNo
n) -> (Set ChunkNo
chunk, ChunkNo -> Set ChunkNo -> Set ChunkNo
forall a. Ord a => a -> Set a -> Set a
Set.insert ChunkNo
n Set ChunkNo
primary, Set ChunkNo
secondary)
        Just (String
"secondary", ChunkNo
n) -> (Set ChunkNo
chunk, Set ChunkNo
primary, ChunkNo -> Set ChunkNo -> Set ChunkNo
forall a. Ord a => a -> Set a -> Set a
Set.insert ChunkNo
n Set ChunkNo
secondary)
        Maybe (String, ChunkNo)
_                     -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
fs

-- | Remove all chunk and index starting from the given chunk (included).
removeFilesStartingFrom :: (HasCallStack, Monad m)
                        => HasFS m h
                        -> ChunkNo
                        -> m ()
removeFilesStartingFrom :: forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> ChunkNo -> m ()
removeFilesStartingFrom HasFS { HasCallStack => FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
removeFile, HasCallStack => FsPath -> m (Set String)
listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory } ChunkNo
chunk = do
    Set String
filesInDBFolder <- HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory ([String] -> FsPath
mkFsPath [])
    let (Set ChunkNo
chunkFiles, Set ChunkNo
primaryFiles, Set ChunkNo
secondaryFiles) = Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
dbFilesOnDisk Set String
filesInDBFolder
    [ChunkNo] -> (ChunkNo -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((ChunkNo -> Bool) -> [ChunkNo] -> [ChunkNo]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
>= ChunkNo
chunk) (Set ChunkNo -> [ChunkNo]
forall a. Set a -> [a]
Set.toDescList Set ChunkNo
chunkFiles)) ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
e ->
      HasCallStack => FsPath -> m ()
FsPath -> m ()
removeFile (ChunkNo -> FsPath
fsPathChunkFile ChunkNo
e)
    [ChunkNo] -> (ChunkNo -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((ChunkNo -> Bool) -> [ChunkNo] -> [ChunkNo]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
>= ChunkNo
chunk) (Set ChunkNo -> [ChunkNo]
forall a. Set a -> [a]
Set.toDescList Set ChunkNo
primaryFiles)) ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
i ->
      HasCallStack => FsPath -> m ()
FsPath -> m ()
removeFile (ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
i)
    [ChunkNo] -> (ChunkNo -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((ChunkNo -> Bool) -> [ChunkNo] -> [ChunkNo]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ChunkNo -> ChunkNo -> Bool
forall a. Ord a => a -> a -> Bool
>= ChunkNo
chunk) (Set ChunkNo -> [ChunkNo]
forall a. Set a -> [a]
Set.toDescList Set ChunkNo
secondaryFiles)) ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
i ->
      HasCallStack => FsPath -> m ()
FsPath -> m ()
removeFile (ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
i)

-- | Rewrap 'FsError' in a 'ImmutableDBError'.
wrapFsError ::
     forall blk m a. (MonadCatch m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> m a
  -> m a
wrapFsError :: forall blk (m :: * -> *) a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m a
wrapFsError Proxy blk
_ = (FsError -> m a) -> m a -> m a
forall e a. Exception e => (e -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle ((FsError -> m a) -> m a -> m a) -> (FsError -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure @blk (UnexpectedFailure blk -> m a)
-> (FsError -> UnexpectedFailure blk) -> FsError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsError -> UnexpectedFailure blk
forall blk. FsError -> UnexpectedFailure blk
FileSystemError

-- | Execute an action and catch the 'ImmutableDBError' and 'FsError' that can
-- be thrown by it, and wrap the 'FsError' in an 'ImmutableDBError' using the
-- 'FileSystemError' constructor.
--
-- This should be used whenever you want to run an action on the ImmutableDB
-- and catch the 'ImmutableDBError' and the 'FsError' (wrapped in the former)
-- it may thrown.
tryImmutableDB ::
     forall m blk a. (MonadCatch m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> m a
  -> m (Either (ImmutableDBError blk) a)
tryImmutableDB :: forall (m :: * -> *) blk a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m (Either (ImmutableDBError blk) a)
tryImmutableDB Proxy blk
pb = m a -> m (Either (ImmutableDBError blk) a)
forall e a. Exception e => m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m a -> m (Either (ImmutableDBError blk) a))
-> (m a -> m a) -> m a -> m (Either (ImmutableDBError blk) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> m a -> m a
forall blk (m :: * -> *) a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m a
wrapFsError Proxy blk
pb

-- | Wrapper around 'Get.runGetOrFail' that throws an 'InvalidFileError' when
-- it failed or when there was unconsumed input.
runGet ::
     forall blk a m.
     (HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> FsPath
  -> Get a
  -> Lazy.ByteString
  -> m a
runGet :: forall blk a (m :: * -> *).
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m a
runGet Proxy blk
_ FsPath
file Get a
get ByteString
bl = case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Get.runGetOrFail Get a
get ByteString
bl of
    Right (ByteString
unconsumed, ByteOffset
_, a
primary)
      | ByteString -> Bool
Lazy.null ByteString
unconsumed
      -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
primary
      | Bool
otherwise
      -> UnexpectedFailure blk -> m a
forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure (UnexpectedFailure blk -> m a) -> UnexpectedFailure blk -> m a
forall a b. (a -> b) -> a -> b
$
           forall blk.
FsPath -> String -> PrettyCallStack -> UnexpectedFailure blk
InvalidFileError @blk FsPath
file String
"left-over bytes" PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
    Left (ByteString
_, ByteOffset
_, String
msg)
      -> UnexpectedFailure blk -> m a
forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure (UnexpectedFailure blk -> m a) -> UnexpectedFailure blk -> m a
forall a b. (a -> b) -> a -> b
$
           forall blk.
FsPath -> String -> PrettyCallStack -> UnexpectedFailure blk
InvalidFileError @blk FsPath
file String
msg PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

-- | Same as 'runGet', but allows unconsumed input and returns it.
runGetWithUnconsumed ::
     forall blk a m.
     (HasCallStack, MonadThrow m, StandardHash blk, Typeable blk)
  => Proxy blk
  -> FsPath
  -> Get a
  -> Lazy.ByteString
  -> m (Lazy.ByteString, a)
runGetWithUnconsumed :: forall blk a (m :: * -> *).
(HasCallStack, MonadThrow m, StandardHash blk, Typeable blk) =>
Proxy blk -> FsPath -> Get a -> ByteString -> m (ByteString, a)
runGetWithUnconsumed Proxy blk
_ FsPath
file Get a
get ByteString
bl = case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Get.runGetOrFail Get a
get ByteString
bl of
    Right (ByteString
unconsumed, ByteOffset
_, a
primary)
      -> (ByteString, a) -> m (ByteString, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
unconsumed, a
primary)
    Left (ByteString
_, ByteOffset
_, String
msg)
      -> UnexpectedFailure blk -> m (ByteString, a)
forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure (UnexpectedFailure blk -> m (ByteString, a))
-> UnexpectedFailure blk -> m (ByteString, a)
forall a b. (a -> b) -> a -> b
$
           forall blk.
FsPath -> String -> PrettyCallStack -> UnexpectedFailure blk
InvalidFileError @blk FsPath
file String
msg PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

-- | Check whether the given checksums match. If not, throw a
-- 'ChecksumMismatchError'.
checkChecksum ::
     (HasCallStack, HasHeader blk, MonadThrow m)
  => FsPath
  -> RealPoint blk
  -> CRC  -- ^ Expected checksum
  -> CRC  -- ^ Actual checksum
  -> m ()
checkChecksum :: forall blk (m :: * -> *).
(HasCallStack, HasHeader blk, MonadThrow m) =>
FsPath -> RealPoint blk -> CRC -> CRC -> m ()
checkChecksum FsPath
chunkFile RealPoint blk
pt CRC
expected CRC
actual
    | CRC
expected CRC -> CRC -> Bool
forall a. Eq a => a -> a -> Bool
== CRC
actual
    = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise
    = UnexpectedFailure blk -> m ()
forall blk (m :: * -> *) a.
(StandardHash blk, Typeable blk, MonadThrow m) =>
UnexpectedFailure blk -> m a
throwUnexpectedFailure (UnexpectedFailure blk -> m ()) -> UnexpectedFailure blk -> m ()
forall a b. (a -> b) -> a -> b
$
        RealPoint blk
-> CRC -> CRC -> FsPath -> PrettyCallStack -> UnexpectedFailure blk
forall blk.
RealPoint blk
-> CRC -> CRC -> FsPath -> PrettyCallStack -> UnexpectedFailure blk
ChecksumMismatchError RealPoint blk
pt CRC
expected CRC
actual FsPath
chunkFile PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack