{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
module System.Nix.Store.Remote
( module System.Nix.Store.Types
, module System.Nix.Store.Remote.Client
, module System.Nix.Store.Remote.MonadStore
, module System.Nix.Store.Remote.Types
, MonadStore
, runStore
, runStoreConnection
, runStoreSocket
, runDaemon
, runDaemonConnection
, justdoit
) where
import Control.Monad.Catch (MonadMask)
import Control.Monad.Conc.Class (MonadConc)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default.Class (Default(def))
import Network.Socket (Family, SockAddr(SockAddrUnix))
import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
import System.Nix.Store.Remote.MonadStore
( runRemoteStoreT
, MonadRemoteStore(..)
, RemoteStoreT
, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
import System.Nix.Store.Remote.Client
import System.Nix.Store.Remote.Server (WorkerHelper, runProxyDaemon)
import System.Nix.Store.Remote.Types
import qualified Control.Monad.Catch
import qualified Network.Socket
import System.Nix.StorePath (StorePath)
import qualified System.Nix.StorePath
type MonadStore = RemoteStoreT IO
runStore
:: ( MonadIO m
, MonadMask m
)
=> RemoteStoreT m a
-> Run m a
runStore :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RemoteStoreT m a -> Run m a
runStore = StoreConnection -> RemoteStoreT m a -> Run m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
StoreConnection -> RemoteStoreT m a -> Run m a
runStoreConnection StoreConnection
forall a. Default a => a
def
runStoreConnection
:: ( MonadIO m
, MonadMask m
)
=> StoreConnection
-> RemoteStoreT m a
-> Run m a
runStoreConnection :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
StoreConnection -> RemoteStoreT m a -> Run m a
runStoreConnection StoreConnection
sc RemoteStoreT m a
k =
StoreConnection -> m (Either RemoteStoreError (Family, SockAddr))
forall (m :: * -> *).
MonadIO m =>
StoreConnection -> m (Either RemoteStoreError (Family, SockAddr))
connectionToSocket StoreConnection
sc
m (Either RemoteStoreError (Family, SockAddr))
-> (Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError a, DList Logger))
-> m (Either RemoteStoreError a, DList Logger)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left RemoteStoreError
e -> (Either RemoteStoreError a, DList Logger)
-> m (Either RemoteStoreError a, DList Logger)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteStoreError -> Either RemoteStoreError a
forall a b. a -> Either a b
Left RemoteStoreError
e, DList Logger
forall a. Monoid a => a
mempty)
Right (Family
fam, SockAddr
sock) -> Family
-> SockAddr
-> RemoteStoreT m a
-> m (Either RemoteStoreError a, DList Logger)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Family -> SockAddr -> RemoteStoreT m a -> Run m a
runStoreSocket Family
fam SockAddr
sock RemoteStoreT m a
k
runStoreSocket
:: ( MonadIO m
, MonadMask m
)
=> Family
-> SockAddr
-> RemoteStoreT m a
-> Run m a
runStoreSocket :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Family -> SockAddr -> RemoteStoreT m a -> Run m a
runStoreSocket Family
sockFamily SockAddr
sockAddr RemoteStoreT m a
code =
m Socket
-> (Socket -> m ())
-> (Socket -> m (Either RemoteStoreError a, DList Logger))
-> m (Either RemoteStoreError a, DList Logger)
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
Control.Monad.Catch.bracket
(IO Socket -> m Socket
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Socket
open)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Socket -> IO ()) -> Socket -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
Network.Socket.close (Socket -> IO ()) -> (Socket -> Socket) -> Socket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> Socket
forall r. HasStoreSocket r => r -> Socket
hasStoreSocket)
(\Socket
s -> Socket
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
forall (m :: * -> *) a.
Monad m =>
Socket
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
runRemoteStoreT Socket
s (RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger))
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
forall a b. (a -> b) -> a -> b
$ RemoteStoreT m ClientHandshakeOutput
forall (m :: * -> *). MonadRemoteStore m => m ClientHandshakeOutput
greetServer RemoteStoreT m ClientHandshakeOutput
-> RemoteStoreT m a -> RemoteStoreT m a
forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteStoreT m a
code)
where
open :: IO Socket
open = do
Socket
soc <-
Family -> SocketType -> ProtocolNumber -> IO Socket
Network.Socket.socket
Family
sockFamily
SocketType
Network.Socket.Stream
ProtocolNumber
Network.Socket.defaultProtocol
Socket -> SockAddr -> IO ()
Network.Socket.connect Socket
soc SockAddr
sockAddr
Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
soc
justdoit :: Run IO (Bool, Bool)
justdoit :: Run IO (Bool, Bool)
justdoit = do
WorkerHelper IO
-> RemoteStoreT IO ()
-> StoreConnection
-> Run IO (Bool, Bool)
-> Run IO (Bool, Bool)
forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m
-> RemoteStoreT m () -> StoreConnection -> m a -> m a
runDaemonConnection RemoteStoreT IO a -> Run IO a
WorkerHelper IO
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RemoteStoreT m a -> Run m a
runStore (() -> RemoteStoreT IO ()
forall a. a -> RemoteStoreT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (StoreSocketPath -> StoreConnection
StoreConnection_Socket StoreSocketPath
"/tmp/dsock") (Run IO (Bool, Bool) -> Run IO (Bool, Bool))
-> Run IO (Bool, Bool) -> Run IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$
StoreConnection
-> RemoteStoreT IO (Bool, Bool) -> Run IO (Bool, Bool)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
StoreConnection -> RemoteStoreT m a -> Run m a
runStoreConnection (StoreSocketPath -> StoreConnection
StoreConnection_Socket StoreSocketPath
"/tmp/dsock")
(RemoteStoreT IO (Bool, Bool) -> Run IO (Bool, Bool))
-> RemoteStoreT IO (Bool, Bool) -> Run IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
Bool
a <- StorePath -> RemoteStoreT IO Bool
forall (m :: * -> *). MonadRemoteStore m => StorePath -> m Bool
isValidPath StorePath
pth
Bool
b <- StorePath -> RemoteStoreT IO Bool
forall (m :: * -> *). MonadRemoteStore m => StorePath -> m Bool
isValidPath StorePath
pth
(Bool, Bool) -> RemoteStoreT IO (Bool, Bool)
forall a. a -> RemoteStoreT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
a, Bool
b)
where
pth :: StorePath
pth :: StorePath
pth =
(InvalidPathError -> StorePath)
-> (StorePath -> StorePath)
-> Either InvalidPathError StorePath
-> StorePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> StorePath
forall a. HasCallStack => [Char] -> a
error ([Char] -> StorePath)
-> (InvalidPathError -> [Char]) -> InvalidPathError -> StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidPathError -> [Char]
forall a. Show a => a -> [Char]
show) StorePath -> StorePath
forall a. a -> a
id
(Either InvalidPathError StorePath -> StorePath)
-> Either InvalidPathError StorePath -> StorePath
forall a b. (a -> b) -> a -> b
$ StoreDir -> Text -> Either InvalidPathError StorePath
System.Nix.StorePath.parsePathFromText
StoreDir
forall a. Default a => a
def
Text
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
runDaemon
:: forall m a
. ( MonadIO m
, MonadConc m
)
=> WorkerHelper m
-> m a
-> m a
runDaemon :: forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m -> m a -> m a
runDaemon WorkerHelper m
workerHelper =
WorkerHelper m
-> RemoteStoreT m () -> StoreConnection -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m
-> RemoteStoreT m () -> StoreConnection -> m a -> m a
runDaemonConnection
RemoteStoreT m a -> Run m a
WorkerHelper m
workerHelper
(() -> RemoteStoreT m ()
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
StoreConnection
forall a. Default a => a
def
runDaemonConnection
:: forall m a
. ( MonadIO m
, MonadConc m
)
=> WorkerHelper m
-> RemoteStoreT m ()
-> StoreConnection
-> m a
-> m a
runDaemonConnection :: forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m
-> RemoteStoreT m () -> StoreConnection -> m a -> m a
runDaemonConnection WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet StoreConnection
sc m a
k =
StoreConnection -> m (Either RemoteStoreError (Family, SockAddr))
forall (m :: * -> *).
MonadIO m =>
StoreConnection -> m (Either RemoteStoreError (Family, SockAddr))
connectionToSocket StoreConnection
sc
m (Either RemoteStoreError (Family, SockAddr))
-> (Either RemoteStoreError (Family, SockAddr) -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left RemoteStoreError
e -> [Char] -> m a
forall a. HasCallStack => [Char] -> a
error ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> [Char]
forall a. Show a => a -> [Char]
show RemoteStoreError
e
Right (Family
fam, SockAddr
sock) -> WorkerHelper m
-> RemoteStoreT m () -> Family -> SockAddr -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m
-> RemoteStoreT m () -> Family -> SockAddr -> m a -> m a
runDaemonSocket RemoteStoreT m a -> Run m a
WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Family
fam SockAddr
sock m a
k
runDaemonSocket
:: forall m a
. ( MonadIO m
, MonadConc m
)
=> WorkerHelper m
-> RemoteStoreT m ()
-> Family
-> SockAddr
-> m a
-> m a
runDaemonSocket :: forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m
-> RemoteStoreT m () -> Family -> SockAddr -> m a -> m a
runDaemonSocket WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Family
sockFamily SockAddr
sockAddr m a
k =
m Socket -> (Socket -> m ()) -> (Socket -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
Control.Monad.Catch.bracket
(IO Socket -> m Socket
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ Family -> SocketType -> ProtocolNumber -> IO Socket
Network.Socket.socket
Family
sockFamily
SocketType
Network.Socket.Stream
ProtocolNumber
Network.Socket.defaultProtocol
)
(\Socket
lsock -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
Network.Socket.close Socket
lsock)
((Socket -> m a) -> m a) -> (Socket -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Socket
lsock -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
Network.Socket.bind Socket
lsock SockAddr
sockAddr
WorkerHelper m -> RemoteStoreT m () -> Socket -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m -> RemoteStoreT m () -> Socket -> m a -> m a
runProxyDaemon RemoteStoreT m a -> Run m a
WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Socket
lsock m a
k
connectionToSocket
:: MonadIO m
=> StoreConnection
-> m (Either RemoteStoreError (Family, SockAddr))
connectionToSocket :: forall (m :: * -> *).
MonadIO m =>
StoreConnection -> m (Either RemoteStoreError (Family, SockAddr))
connectionToSocket (StoreConnection_Socket (StoreSocketPath [Char]
f)) =
Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr)))
-> Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr))
forall a b. (a -> b) -> a -> b
$ (Family, SockAddr) -> Either RemoteStoreError (Family, SockAddr)
forall a. a -> Either RemoteStoreError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Family
Network.Socket.AF_UNIX
, [Char] -> SockAddr
SockAddrUnix [Char]
f
)
connectionToSocket (StoreConnection_TCP StoreTCP{Int
[Char]
storeTCPHost :: [Char]
storeTCPPort :: Int
storeTCPHost :: StoreTCP -> [Char]
storeTCPPort :: StoreTCP -> Int
..}) = do
[AddrInfo]
addrInfo <- IO [AddrInfo] -> m [AddrInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddrInfo] -> m [AddrInfo]) -> IO [AddrInfo] -> m [AddrInfo]
forall a b. (a -> b) -> a -> b
$ Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO [AddrInfo]
Network.Socket.getAddrInfo
(AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
Network.Socket.defaultHints)
([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
storeTCPHost)
([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
storeTCPPort)
case [AddrInfo]
addrInfo of
(AddrInfo
sockAddr:[AddrInfo]
_) ->
Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr)))
-> Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr))
forall a b. (a -> b) -> a -> b
$ (Family, SockAddr) -> Either RemoteStoreError (Family, SockAddr)
forall a. a -> Either RemoteStoreError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( AddrInfo -> Family
Network.Socket.addrFamily AddrInfo
sockAddr
, AddrInfo -> SockAddr
Network.Socket.addrAddress AddrInfo
sockAddr
)
[AddrInfo]
_ -> Either RemoteStoreError (Family, SockAddr)
-> m (Either RemoteStoreError (Family, SockAddr))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteStoreError -> Either RemoteStoreError (Family, SockAddr)
forall a b. a -> Either a b
Left RemoteStoreError
RemoteStoreError_GetAddrInfoFailed)