{-# 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
  -- * Compat
  , MonadStore
  -- * Runners
  , runStore
  , runStoreConnection
  , runStoreSocket
  -- ** Daemon
  , 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
-- see TODO bellow
--import qualified System.Directory

-- wip justdoit
import System.Nix.StorePath (StorePath)
import qualified System.Nix.StorePath

-- * Compat

type MonadStore = RemoteStoreT IO

-- * Runners

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

-- | Run an emulated nix daemon using given @StoreConnection@
-- the deamon will close when the continuation returns.
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

-- | Run an emulated nix daemon using given @StoreConnection@
-- the deamon will close when the continuation returns.
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
    -- TODO: the: (\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
    -- branch should really be (and even removeFile is currently omitted)
    -- a file lock followed by unlink *before* bind rather than after close.  If
    -- the program crashes (or loses power or something) then a stale unix
    -- socket will stick around and prevent the daemon from starting.  using a
    -- lock file instead means only one "copy" of the daemon can hold the lock,
    -- and can safely unlink the socket before binding no matter how shutdown
    -- occured.

    -- set up the listening socket
    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)