{-# LANGUAGE RecordWildCards #-}

module Data.Snowchecked.Encoding.Class ( IsFlake(..), Flakeish(..), goodFish ) where

import           Data.Snowchecked.Internal.Import

{-| Something that might be a 'Flake'.  The fields might not be truncated to the appropriate size.
 -}
data Flakeish = Flakeish
	{ Flakeish -> Word256
fishNodeId    ::  Word256
	, Flakeish -> Word256
fishCount     ::  Word256
	, Flakeish -> Word256
fishTime      ::  Word256
	, Flakeish -> Word256
fishCheck     ::  Word256
	}

{-| Is this 'Flakeish' valid under the given 'SnowcheckedConfig' settings? -}
goodFish :: SnowcheckedConfig -> Flakeish -> Bool
goodFish :: SnowcheckedConfig -> Flakeish -> Bool
goodFish SnowcheckedConfig{Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
..} Flakeish{Word256
fishCheck :: Word256
fishTime :: Word256
fishCount :: Word256
fishNodeId :: Word256
fishCheck :: Flakeish -> Word256
fishTime :: Flakeish -> Word256
fishCount :: Flakeish -> Word256
fishNodeId :: Flakeish -> Word256
..} =
		Word256
checkInteger forall a. Eq a => a -> a -> Bool
== forall a. (Num a, Bits a) => a -> Int -> a
cutBits (Word256
nodeInteger forall a. Num a => a -> a -> a
+ Word256
countInteger forall a. Num a => a -> a -> a
+ Word256
timeInteger) (forall a. Integral a => a -> Int
toInt Word8
confCheckBits)
	where
		checkInteger :: Word256
checkInteger = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishCheck (forall a. Integral a => a -> Int
toInt Word8
confCheckBits)
		nodeInteger :: Word256
nodeInteger = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishNodeId (forall a. Integral a => a -> Int
toInt Word8
confNodeBits)
		countInteger :: Word256
countInteger = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishCount (forall a. Integral a => a -> Int
toInt Word8
confCountBits)
		timeInteger :: Word256
timeInteger = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishTime (forall a. Integral a => a -> Int
toInt Word8
confTimeBits)
{-# INLINEABLE goodFish #-}

{-| The class of things that can be generated from and to a 'Flake'.
 -}
class IsFlake a where
	{-# MINIMAL fromFlake, (parseFish | parseFlake) #-}
	fromFlake :: Flake -> a
	parseFlake :: (MonadFail m) => SnowcheckedConfig -> a -> m Flake
	parseFlake cfg :: SnowcheckedConfig
cfg@SnowcheckedConfig{Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
..} a
a = forall a (m :: * -> *).
(IsFlake a, MonadFail m) =>
SnowcheckedConfig -> a -> m Flakeish
parseFish SnowcheckedConfig
cfg a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \fish :: Flakeish
fish@Flakeish{Word256
fishCheck :: Word256
fishTime :: Word256
fishCount :: Word256
fishNodeId :: Word256
fishCheck :: Flakeish -> Word256
fishTime :: Flakeish -> Word256
fishCount :: Flakeish -> Word256
fishNodeId :: Flakeish -> Word256
..} ->
		if SnowcheckedConfig -> Flakeish -> Bool
goodFish SnowcheckedConfig
cfg Flakeish
fish then
			forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Flake
				{ flakeTime :: Word256
flakeTime = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishTime (forall a. Integral a => a -> Int
toInt Word8
confTimeBits)
				, flakeCount :: Word256
flakeCount = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishCount (forall a. Integral a => a -> Int
toInt Word8
confCountBits)
				, flakeNodeId :: Word256
flakeNodeId = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
fishNodeId (forall a. Integral a => a -> Int
toInt Word8
confNodeBits)
				, flakeConfig :: SnowcheckedConfig
flakeConfig = SnowcheckedConfig
cfg
				}
		else
			forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Checksum is incorrect for Snowchecked flake"

	parseFish :: (MonadFail m) => SnowcheckedConfig -> a -> m Flakeish
	parseFish SnowcheckedConfig
cfg a
a = Flake -> Flakeish
toFlakeish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(IsFlake a, MonadFail m) =>
SnowcheckedConfig -> a -> m Flake
parseFlake SnowcheckedConfig
cfg a
a
		where
			toFlakeish :: Flake -> Flakeish
toFlakeish Flake{Word256
SnowcheckedConfig
flakeConfig :: SnowcheckedConfig
flakeNodeId :: Word256
flakeCount :: Word256
flakeTime :: Word256
flakeConfig :: Flake -> SnowcheckedConfig
flakeNodeId :: Flake -> Word256
flakeCount :: Flake -> Word256
flakeTime :: Flake -> Word256
..} = Flakeish
				{ fishTime :: Word256
fishTime = Word256
flakeTime
				, fishCount :: Word256
fishCount = Word256
flakeCount
				, fishNodeId :: Word256
fishNodeId = Word256
flakeNodeId
				, fishCheck :: Word256
fishCheck = Word256
flakeTime forall a. Num a => a -> a -> a
+ Word256
flakeCount forall a. Num a => a -> a -> a
+ Word256
flakeNodeId
				}