module System.Nix.Store.Remote.Types.WorkerMagic
  ( WorkerMagic(..)
  , workerMagicToWord64
  , word64ToWorkerMagic
  ) where

import Data.Word (Word64)
import GHC.Generics (Generic)

-- | WorkerMagic
--
-- Magic numbers exchange during handshake
data WorkerMagic
  = WorkerMagic_One
  | WorkerMagic_Two
  deriving (WorkerMagic -> WorkerMagic -> Bool
(WorkerMagic -> WorkerMagic -> Bool)
-> (WorkerMagic -> WorkerMagic -> Bool) -> Eq WorkerMagic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkerMagic -> WorkerMagic -> Bool
== :: WorkerMagic -> WorkerMagic -> Bool
$c/= :: WorkerMagic -> WorkerMagic -> Bool
/= :: WorkerMagic -> WorkerMagic -> Bool
Eq, (forall x. WorkerMagic -> Rep WorkerMagic x)
-> (forall x. Rep WorkerMagic x -> WorkerMagic)
-> Generic WorkerMagic
forall x. Rep WorkerMagic x -> WorkerMagic
forall x. WorkerMagic -> Rep WorkerMagic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkerMagic -> Rep WorkerMagic x
from :: forall x. WorkerMagic -> Rep WorkerMagic x
$cto :: forall x. Rep WorkerMagic x -> WorkerMagic
to :: forall x. Rep WorkerMagic x -> WorkerMagic
Generic, Eq WorkerMagic
Eq WorkerMagic =>
(WorkerMagic -> WorkerMagic -> Ordering)
-> (WorkerMagic -> WorkerMagic -> Bool)
-> (WorkerMagic -> WorkerMagic -> Bool)
-> (WorkerMagic -> WorkerMagic -> Bool)
-> (WorkerMagic -> WorkerMagic -> Bool)
-> (WorkerMagic -> WorkerMagic -> WorkerMagic)
-> (WorkerMagic -> WorkerMagic -> WorkerMagic)
-> Ord WorkerMagic
WorkerMagic -> WorkerMagic -> Bool
WorkerMagic -> WorkerMagic -> Ordering
WorkerMagic -> WorkerMagic -> WorkerMagic
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
$ccompare :: WorkerMagic -> WorkerMagic -> Ordering
compare :: WorkerMagic -> WorkerMagic -> Ordering
$c< :: WorkerMagic -> WorkerMagic -> Bool
< :: WorkerMagic -> WorkerMagic -> Bool
$c<= :: WorkerMagic -> WorkerMagic -> Bool
<= :: WorkerMagic -> WorkerMagic -> Bool
$c> :: WorkerMagic -> WorkerMagic -> Bool
> :: WorkerMagic -> WorkerMagic -> Bool
$c>= :: WorkerMagic -> WorkerMagic -> Bool
>= :: WorkerMagic -> WorkerMagic -> Bool
$cmax :: WorkerMagic -> WorkerMagic -> WorkerMagic
max :: WorkerMagic -> WorkerMagic -> WorkerMagic
$cmin :: WorkerMagic -> WorkerMagic -> WorkerMagic
min :: WorkerMagic -> WorkerMagic -> WorkerMagic
Ord, Int -> WorkerMagic -> ShowS
[WorkerMagic] -> ShowS
WorkerMagic -> String
(Int -> WorkerMagic -> ShowS)
-> (WorkerMagic -> String)
-> ([WorkerMagic] -> ShowS)
-> Show WorkerMagic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkerMagic -> ShowS
showsPrec :: Int -> WorkerMagic -> ShowS
$cshow :: WorkerMagic -> String
show :: WorkerMagic -> String
$cshowList :: [WorkerMagic] -> ShowS
showList :: [WorkerMagic] -> ShowS
Show)

workerMagicToWord64 :: WorkerMagic -> Word64
workerMagicToWord64 :: WorkerMagic -> Word64
workerMagicToWord64 = \case
  WorkerMagic
WorkerMagic_One -> Word64
0x6e697863
  WorkerMagic
WorkerMagic_Two -> Word64
0x6478696f

word64ToWorkerMagic :: Word64 -> Either String WorkerMagic
word64ToWorkerMagic :: Word64 -> Either String WorkerMagic
word64ToWorkerMagic = \case
  Word64
0x6e697863 -> WorkerMagic -> Either String WorkerMagic
forall a b. b -> Either a b
Right WorkerMagic
WorkerMagic_One
  Word64
0x6478696f -> WorkerMagic -> Either String WorkerMagic
forall a b. b -> Either a b
Right WorkerMagic
WorkerMagic_Two
  Word64
x -> String -> Either String WorkerMagic
forall a b. a -> Either a b
Left (String -> Either String WorkerMagic)
-> String -> Either String WorkerMagic
forall a b. (a -> b) -> a -> b
$ String
"Invalid WorkerMagic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
x