module Hercules.Agent.Store where

import Hercules.Agent.WorkerProtocol.OutputInfo (OutputInfo (OutputInfo))
import Hercules.Agent.WorkerProtocol.OutputInfo qualified
import Hercules.CNix.Store (DerivationOutput (derivationOutputName, derivationOutputPath), Store, getStorePathBaseName, queryPathInfo, validPathInfoNarHash32, validPathInfoNarSize, validPathInfoReferences')
import Hercules.CNix.Store qualified as CNix
import Protolude

toDrvInfo :: Store -> DerivationOutput -> IO OutputInfo
toDrvInfo :: Store -> DerivationOutput -> IO OutputInfo
toDrvInfo Store
store DerivationOutput
drvOut = do
  -- FIXME: ca-derivations: always get the built path
  Maybe (ForeignPtr (Ref ValidPathInfo))
vpi <- Maybe StorePath
-> (StorePath -> IO (ForeignPtr (Ref ValidPathInfo)))
-> IO (Maybe (ForeignPtr (Ref ValidPathInfo)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (DerivationOutput -> Maybe StorePath
derivationOutputPath DerivationOutput
drvOut) (Store -> StorePath -> IO (ForeignPtr (Ref ValidPathInfo))
queryPathInfo Store
store)
  Maybe ByteString
hash_ <- (ForeignPtr (Ref ValidPathInfo) -> IO ByteString)
-> Maybe (ForeignPtr (Ref ValidPathInfo)) -> IO (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ForeignPtr (Ref ValidPathInfo) -> IO ByteString
validPathInfoNarHash32 Maybe (ForeignPtr (Ref ValidPathInfo))
vpi
  Maybe ByteString
path <- (StorePath -> IO ByteString)
-> Maybe StorePath -> IO (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Store -> StorePath -> IO ByteString
CNix.storePathToPath Store
store) (DerivationOutput -> Maybe StorePath
derivationOutputPath DerivationOutput
drvOut)
  let size :: Maybe Int64
size = (ForeignPtr (Ref ValidPathInfo) -> Int64)
-> Maybe (ForeignPtr (Ref ValidPathInfo)) -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr (Ref ValidPathInfo) -> Int64
validPathInfoNarSize Maybe (ForeignPtr (Ref ValidPathInfo))
vpi
  Maybe [ByteString]
refs <- (ForeignPtr (Ref ValidPathInfo) -> IO [ByteString])
-> Maybe (ForeignPtr (Ref ValidPathInfo))
-> IO (Maybe [ByteString])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((StorePath -> IO ByteString) -> [StorePath] -> IO [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse StorePath -> IO ByteString
getStorePathBaseName ([StorePath] -> IO [ByteString])
-> (ForeignPtr (Ref ValidPathInfo) -> IO [StorePath])
-> ForeignPtr (Ref ValidPathInfo)
-> IO [ByteString]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ForeignPtr (Ref ValidPathInfo) -> IO [StorePath]
validPathInfoReferences') Maybe (ForeignPtr (Ref ValidPathInfo))
vpi
  OutputInfo -> IO OutputInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    OutputInfo
      { name :: ByteString
name = DerivationOutput -> ByteString
derivationOutputName DerivationOutput
drvOut,
        path :: ByteString
path = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
path,
        hash :: ByteString
hash = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
hash_,
        size :: Int64
size = Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
0 Maybe Int64
size,
        references :: [ByteString]
references = [ByteString] -> Maybe [ByteString] -> [ByteString]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ByteString]
refs
      }