{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Tahoe.CHK.Types where

import Data.Word (
    Word16,
 )

import qualified Data.ByteString as B
import Data.TreeDiff.Class (ToExpr)
import GHC.Generics (Generic)
import Tahoe.CHK.SHA256d (Digest')

-- 16 bytes
type StorageIndex = B.ByteString

-- How much data is there
type Size = Integer

-- Byte-based position into a share
type Offset = Integer

-- Segment-based position into a share
type SegmentNum = Int

-- With respect to FEC encoding, the number of a share.
type ShareNum = Int

-- The hash of a FEC-encoded block, parameterized on the hash algorithm.
type BlockHash a = Digest' a

-- The hash of some ciphertext, parameterized on the hash algorithm.
type CrypttextHash a = Digest' a

-- Erasure encoding / placement parameters
type Total = Word16
type Happy = ShareNum -- This is not like the others.
type Required = Word16
type SegmentSize = Size
data Parameters = Parameters
    { Parameters -> SegmentSize
paramSegmentSize :: SegmentSize
    , Parameters -> Total
paramTotalShares :: Total
    , Parameters -> Happy
paramHappyShares :: Happy
    , Parameters -> Total
paramRequiredShares :: Required
    }
    deriving (Happy -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
(Happy -> Parameters -> ShowS)
-> (Parameters -> String)
-> ([Parameters] -> ShowS)
-> Show Parameters
forall a.
(Happy -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Happy -> Parameters -> ShowS
$cshowsPrec :: Happy -> Parameters -> ShowS
Show, Eq Parameters
Eq Parameters
-> (Parameters -> Parameters -> Ordering)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Parameters)
-> (Parameters -> Parameters -> Parameters)
-> Ord Parameters
Parameters -> Parameters -> Bool
Parameters -> Parameters -> Ordering
Parameters -> Parameters -> Parameters
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
min :: Parameters -> Parameters -> Parameters
$cmin :: Parameters -> Parameters -> Parameters
max :: Parameters -> Parameters -> Parameters
$cmax :: Parameters -> Parameters -> Parameters
>= :: Parameters -> Parameters -> Bool
$c>= :: Parameters -> Parameters -> Bool
> :: Parameters -> Parameters -> Bool
$c> :: Parameters -> Parameters -> Bool
<= :: Parameters -> Parameters -> Bool
$c<= :: Parameters -> Parameters -> Bool
< :: Parameters -> Parameters -> Bool
$c< :: Parameters -> Parameters -> Bool
compare :: Parameters -> Parameters -> Ordering
$ccompare :: Parameters -> Parameters -> Ordering
$cp1Ord :: Eq Parameters
Ord, Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: Parameters -> Parameters -> Bool
Eq, (forall x. Parameters -> Rep Parameters x)
-> (forall x. Rep Parameters x -> Parameters) -> Generic Parameters
forall x. Rep Parameters x -> Parameters
forall x. Parameters -> Rep Parameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Parameters x -> Parameters
$cfrom :: forall x. Parameters -> Rep Parameters x
Generic, [Parameters] -> Expr
Parameters -> Expr
(Parameters -> Expr) -> ([Parameters] -> Expr) -> ToExpr Parameters
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [Parameters] -> Expr
$clistToExpr :: [Parameters] -> Expr
toExpr :: Parameters -> Expr
$ctoExpr :: Parameters -> Expr
ToExpr)

requiredToInt :: Required -> Int
requiredToInt :: Total -> Happy
requiredToInt = Total -> Happy
forall a b. (Integral a, Num b) => a -> b
fromIntegral

totalToInt :: Total -> Int
totalToInt :: Total -> Happy
totalToInt = Total -> Happy
forall a b. (Integral a, Num b) => a -> b
fromIntegral