{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module System.Nix.Store.Remote.Types.StoreConfig
  ( ProtoStoreConfig(..)
  , StoreSocketPath(..)
  , StoreTCP(..)
  , StoreConnection(..)
  , HasStoreSocket(..)
  ) where

import Data.Default.Class (Default(def))
import Data.String (IsString)
import GHC.Generics (Generic)
import Network.Socket (Socket)
import System.Nix.StorePath (HasStoreDir(..), StoreDir)
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)

class HasStoreSocket r where
  hasStoreSocket :: r -> Socket

instance HasStoreSocket Socket where
  hasStoreSocket :: Socket -> Socket
hasStoreSocket = Socket -> Socket
forall a. a -> a
id

data ProtoStoreConfig = ProtoStoreConfig
  { ProtoStoreConfig -> StoreDir
protoStoreConfigDir :: StoreDir
  , ProtoStoreConfig -> ProtoVersion
protoStoreConfigProtoVersion :: ProtoVersion
  } deriving (ProtoStoreConfig -> ProtoStoreConfig -> Bool
(ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> (ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> Eq ProtoStoreConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
== :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
$c/= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
/= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
Eq, (forall x. ProtoStoreConfig -> Rep ProtoStoreConfig x)
-> (forall x. Rep ProtoStoreConfig x -> ProtoStoreConfig)
-> Generic ProtoStoreConfig
forall x. Rep ProtoStoreConfig x -> ProtoStoreConfig
forall x. ProtoStoreConfig -> Rep ProtoStoreConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtoStoreConfig -> Rep ProtoStoreConfig x
from :: forall x. ProtoStoreConfig -> Rep ProtoStoreConfig x
$cto :: forall x. Rep ProtoStoreConfig x -> ProtoStoreConfig
to :: forall x. Rep ProtoStoreConfig x -> ProtoStoreConfig
Generic, Eq ProtoStoreConfig
Eq ProtoStoreConfig =>
(ProtoStoreConfig -> ProtoStoreConfig -> Ordering)
-> (ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> (ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> (ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> (ProtoStoreConfig -> ProtoStoreConfig -> Bool)
-> (ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig)
-> (ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig)
-> Ord ProtoStoreConfig
ProtoStoreConfig -> ProtoStoreConfig -> Bool
ProtoStoreConfig -> ProtoStoreConfig -> Ordering
ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig
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 :: ProtoStoreConfig -> ProtoStoreConfig -> Ordering
compare :: ProtoStoreConfig -> ProtoStoreConfig -> Ordering
$c< :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
< :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
$c<= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
<= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
$c> :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
> :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
$c>= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
>= :: ProtoStoreConfig -> ProtoStoreConfig -> Bool
$cmax :: ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig
max :: ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig
$cmin :: ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig
min :: ProtoStoreConfig -> ProtoStoreConfig -> ProtoStoreConfig
Ord, Int -> ProtoStoreConfig -> ShowS
[ProtoStoreConfig] -> ShowS
ProtoStoreConfig -> String
(Int -> ProtoStoreConfig -> ShowS)
-> (ProtoStoreConfig -> String)
-> ([ProtoStoreConfig] -> ShowS)
-> Show ProtoStoreConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtoStoreConfig -> ShowS
showsPrec :: Int -> ProtoStoreConfig -> ShowS
$cshow :: ProtoStoreConfig -> String
show :: ProtoStoreConfig -> String
$cshowList :: [ProtoStoreConfig] -> ShowS
showList :: [ProtoStoreConfig] -> ShowS
Show)

instance Default ProtoStoreConfig where
  def :: ProtoStoreConfig
def = StoreDir -> ProtoVersion -> ProtoStoreConfig
ProtoStoreConfig StoreDir
forall a. Default a => a
def ProtoVersion
forall a. Default a => a
def

instance HasStoreDir StoreDir where
  hasStoreDir :: StoreDir -> StoreDir
hasStoreDir = StoreDir -> StoreDir
forall a. a -> a
id

instance HasStoreDir ProtoStoreConfig where
  hasStoreDir :: ProtoStoreConfig -> StoreDir
hasStoreDir = ProtoStoreConfig -> StoreDir
protoStoreConfigDir

instance HasProtoVersion ProtoStoreConfig where
  hasProtoVersion :: ProtoStoreConfig -> ProtoVersion
hasProtoVersion = ProtoStoreConfig -> ProtoVersion
protoStoreConfigProtoVersion

newtype StoreSocketPath = StoreSocketPath
  { StoreSocketPath -> String
unStoreSocketPath :: FilePath
  }
  deriving newtype (String -> StoreSocketPath
(String -> StoreSocketPath) -> IsString StoreSocketPath
forall a. (String -> a) -> IsString a
$cfromString :: String -> StoreSocketPath
fromString :: String -> StoreSocketPath
IsString)
  deriving stock (StoreSocketPath -> StoreSocketPath -> Bool
(StoreSocketPath -> StoreSocketPath -> Bool)
-> (StoreSocketPath -> StoreSocketPath -> Bool)
-> Eq StoreSocketPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreSocketPath -> StoreSocketPath -> Bool
== :: StoreSocketPath -> StoreSocketPath -> Bool
$c/= :: StoreSocketPath -> StoreSocketPath -> Bool
/= :: StoreSocketPath -> StoreSocketPath -> Bool
Eq, (forall x. StoreSocketPath -> Rep StoreSocketPath x)
-> (forall x. Rep StoreSocketPath x -> StoreSocketPath)
-> Generic StoreSocketPath
forall x. Rep StoreSocketPath x -> StoreSocketPath
forall x. StoreSocketPath -> Rep StoreSocketPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoreSocketPath -> Rep StoreSocketPath x
from :: forall x. StoreSocketPath -> Rep StoreSocketPath x
$cto :: forall x. Rep StoreSocketPath x -> StoreSocketPath
to :: forall x. Rep StoreSocketPath x -> StoreSocketPath
Generic, Eq StoreSocketPath
Eq StoreSocketPath =>
(StoreSocketPath -> StoreSocketPath -> Ordering)
-> (StoreSocketPath -> StoreSocketPath -> Bool)
-> (StoreSocketPath -> StoreSocketPath -> Bool)
-> (StoreSocketPath -> StoreSocketPath -> Bool)
-> (StoreSocketPath -> StoreSocketPath -> Bool)
-> (StoreSocketPath -> StoreSocketPath -> StoreSocketPath)
-> (StoreSocketPath -> StoreSocketPath -> StoreSocketPath)
-> Ord StoreSocketPath
StoreSocketPath -> StoreSocketPath -> Bool
StoreSocketPath -> StoreSocketPath -> Ordering
StoreSocketPath -> StoreSocketPath -> StoreSocketPath
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 :: StoreSocketPath -> StoreSocketPath -> Ordering
compare :: StoreSocketPath -> StoreSocketPath -> Ordering
$c< :: StoreSocketPath -> StoreSocketPath -> Bool
< :: StoreSocketPath -> StoreSocketPath -> Bool
$c<= :: StoreSocketPath -> StoreSocketPath -> Bool
<= :: StoreSocketPath -> StoreSocketPath -> Bool
$c> :: StoreSocketPath -> StoreSocketPath -> Bool
> :: StoreSocketPath -> StoreSocketPath -> Bool
$c>= :: StoreSocketPath -> StoreSocketPath -> Bool
>= :: StoreSocketPath -> StoreSocketPath -> Bool
$cmax :: StoreSocketPath -> StoreSocketPath -> StoreSocketPath
max :: StoreSocketPath -> StoreSocketPath -> StoreSocketPath
$cmin :: StoreSocketPath -> StoreSocketPath -> StoreSocketPath
min :: StoreSocketPath -> StoreSocketPath -> StoreSocketPath
Ord, Int -> StoreSocketPath -> ShowS
[StoreSocketPath] -> ShowS
StoreSocketPath -> String
(Int -> StoreSocketPath -> ShowS)
-> (StoreSocketPath -> String)
-> ([StoreSocketPath] -> ShowS)
-> Show StoreSocketPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreSocketPath -> ShowS
showsPrec :: Int -> StoreSocketPath -> ShowS
$cshow :: StoreSocketPath -> String
show :: StoreSocketPath -> String
$cshowList :: [StoreSocketPath] -> ShowS
showList :: [StoreSocketPath] -> ShowS
Show)

instance Default StoreSocketPath where
  def :: StoreSocketPath
def = String -> StoreSocketPath
StoreSocketPath String
"/nix/var/nix/daemon-socket/socket"

data StoreTCP = StoreTCP
  { StoreTCP -> String
storeTCPHost :: String
  , StoreTCP -> Int
storeTCPPort :: Int
  } deriving (StoreTCP -> StoreTCP -> Bool
(StoreTCP -> StoreTCP -> Bool)
-> (StoreTCP -> StoreTCP -> Bool) -> Eq StoreTCP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreTCP -> StoreTCP -> Bool
== :: StoreTCP -> StoreTCP -> Bool
$c/= :: StoreTCP -> StoreTCP -> Bool
/= :: StoreTCP -> StoreTCP -> Bool
Eq, (forall x. StoreTCP -> Rep StoreTCP x)
-> (forall x. Rep StoreTCP x -> StoreTCP) -> Generic StoreTCP
forall x. Rep StoreTCP x -> StoreTCP
forall x. StoreTCP -> Rep StoreTCP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoreTCP -> Rep StoreTCP x
from :: forall x. StoreTCP -> Rep StoreTCP x
$cto :: forall x. Rep StoreTCP x -> StoreTCP
to :: forall x. Rep StoreTCP x -> StoreTCP
Generic, Eq StoreTCP
Eq StoreTCP =>
(StoreTCP -> StoreTCP -> Ordering)
-> (StoreTCP -> StoreTCP -> Bool)
-> (StoreTCP -> StoreTCP -> Bool)
-> (StoreTCP -> StoreTCP -> Bool)
-> (StoreTCP -> StoreTCP -> Bool)
-> (StoreTCP -> StoreTCP -> StoreTCP)
-> (StoreTCP -> StoreTCP -> StoreTCP)
-> Ord StoreTCP
StoreTCP -> StoreTCP -> Bool
StoreTCP -> StoreTCP -> Ordering
StoreTCP -> StoreTCP -> StoreTCP
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 :: StoreTCP -> StoreTCP -> Ordering
compare :: StoreTCP -> StoreTCP -> Ordering
$c< :: StoreTCP -> StoreTCP -> Bool
< :: StoreTCP -> StoreTCP -> Bool
$c<= :: StoreTCP -> StoreTCP -> Bool
<= :: StoreTCP -> StoreTCP -> Bool
$c> :: StoreTCP -> StoreTCP -> Bool
> :: StoreTCP -> StoreTCP -> Bool
$c>= :: StoreTCP -> StoreTCP -> Bool
>= :: StoreTCP -> StoreTCP -> Bool
$cmax :: StoreTCP -> StoreTCP -> StoreTCP
max :: StoreTCP -> StoreTCP -> StoreTCP
$cmin :: StoreTCP -> StoreTCP -> StoreTCP
min :: StoreTCP -> StoreTCP -> StoreTCP
Ord, Int -> StoreTCP -> ShowS
[StoreTCP] -> ShowS
StoreTCP -> String
(Int -> StoreTCP -> ShowS)
-> (StoreTCP -> String) -> ([StoreTCP] -> ShowS) -> Show StoreTCP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreTCP -> ShowS
showsPrec :: Int -> StoreTCP -> ShowS
$cshow :: StoreTCP -> String
show :: StoreTCP -> String
$cshowList :: [StoreTCP] -> ShowS
showList :: [StoreTCP] -> ShowS
Show)

data StoreConnection
  = StoreConnection_Socket StoreSocketPath
  | StoreConnection_TCP StoreTCP
  deriving (StoreConnection -> StoreConnection -> Bool
(StoreConnection -> StoreConnection -> Bool)
-> (StoreConnection -> StoreConnection -> Bool)
-> Eq StoreConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreConnection -> StoreConnection -> Bool
== :: StoreConnection -> StoreConnection -> Bool
$c/= :: StoreConnection -> StoreConnection -> Bool
/= :: StoreConnection -> StoreConnection -> Bool
Eq, (forall x. StoreConnection -> Rep StoreConnection x)
-> (forall x. Rep StoreConnection x -> StoreConnection)
-> Generic StoreConnection
forall x. Rep StoreConnection x -> StoreConnection
forall x. StoreConnection -> Rep StoreConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoreConnection -> Rep StoreConnection x
from :: forall x. StoreConnection -> Rep StoreConnection x
$cto :: forall x. Rep StoreConnection x -> StoreConnection
to :: forall x. Rep StoreConnection x -> StoreConnection
Generic, Eq StoreConnection
Eq StoreConnection =>
(StoreConnection -> StoreConnection -> Ordering)
-> (StoreConnection -> StoreConnection -> Bool)
-> (StoreConnection -> StoreConnection -> Bool)
-> (StoreConnection -> StoreConnection -> Bool)
-> (StoreConnection -> StoreConnection -> Bool)
-> (StoreConnection -> StoreConnection -> StoreConnection)
-> (StoreConnection -> StoreConnection -> StoreConnection)
-> Ord StoreConnection
StoreConnection -> StoreConnection -> Bool
StoreConnection -> StoreConnection -> Ordering
StoreConnection -> StoreConnection -> StoreConnection
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 :: StoreConnection -> StoreConnection -> Ordering
compare :: StoreConnection -> StoreConnection -> Ordering
$c< :: StoreConnection -> StoreConnection -> Bool
< :: StoreConnection -> StoreConnection -> Bool
$c<= :: StoreConnection -> StoreConnection -> Bool
<= :: StoreConnection -> StoreConnection -> Bool
$c> :: StoreConnection -> StoreConnection -> Bool
> :: StoreConnection -> StoreConnection -> Bool
$c>= :: StoreConnection -> StoreConnection -> Bool
>= :: StoreConnection -> StoreConnection -> Bool
$cmax :: StoreConnection -> StoreConnection -> StoreConnection
max :: StoreConnection -> StoreConnection -> StoreConnection
$cmin :: StoreConnection -> StoreConnection -> StoreConnection
min :: StoreConnection -> StoreConnection -> StoreConnection
Ord, Int -> StoreConnection -> ShowS
[StoreConnection] -> ShowS
StoreConnection -> String
(Int -> StoreConnection -> ShowS)
-> (StoreConnection -> String)
-> ([StoreConnection] -> ShowS)
-> Show StoreConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreConnection -> ShowS
showsPrec :: Int -> StoreConnection -> ShowS
$cshow :: StoreConnection -> String
show :: StoreConnection -> String
$cshowList :: [StoreConnection] -> ShowS
showList :: [StoreConnection] -> ShowS
Show)

instance Default StoreConnection where
  def :: StoreConnection
def = StoreSocketPath -> StoreConnection
StoreConnection_Socket StoreSocketPath
forall a. Default a => a
def