module Cachix.API.Signing
  ( fingerprint,
    passthroughSizeSink,
    passthroughHashSinkB16,
    passthroughHashSink,
  )
where

import Crypto.Hash
import qualified Data.ByteArray as BA
import Data.ByteArray.Encoding (Base (..), convertToBase)
import qualified Data.ByteString as BS
import Data.Conduit
import qualified Data.Conduit.Combinators as CC
import Data.IORef
import qualified Data.Text as T
import Protolude hiding (toS)
import Protolude.Conv

-- perl/lib/Nix/Manifest.pm:fingerprintPath
-- NB: references must be sorted
fingerprint :: Text -> Text -> Integer -> [Text] -> ByteString
fingerprint :: Text -> Text -> Integer -> [Text] -> ByteString
fingerprint Text
storePath Text
narHash Integer
narSize [Text]
references =
  Text -> ByteString
forall a b. StringConv a b => a -> b
toS (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
    Text -> [Text] -> Text
T.intercalate
      Text
";"
      [Text
"1", Text
storePath, Text
narHash, Integer -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Integer
narSize, Text -> [Text] -> Text
T.intercalate Text
"," [Text]
references]

-- Useful sinks for streaming nars
sizeSink :: (MonadIO m) => ConduitT ByteString o m Integer
sizeSink :: forall (m :: * -> *) o.
MonadIO m =>
ConduitT ByteString o m Integer
sizeSink = (Integer -> ByteString -> m Integer)
-> Integer -> ConduitT ByteString o m Integer
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> m a) -> a -> ConduitT b o m a
CC.foldM (\Integer
p ByteString
n -> Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
n))) Integer
0

hashSink :: (MonadIO m) => ConduitT ByteString o m (Context SHA256)
hashSink :: forall (m :: * -> *) o.
MonadIO m =>
ConduitT ByteString o m (Context SHA256)
hashSink = (Context SHA256 -> ByteString -> m (Context SHA256))
-> Context SHA256 -> ConduitT ByteString o m (Context SHA256)
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> m a) -> a -> ConduitT b o m a
CC.foldM (\Context SHA256
p ByteString
n -> Context SHA256 -> m (Context SHA256)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context SHA256 -> ByteString -> Context SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context SHA256
p ByteString
n)) Context SHA256
forall a. HashAlgorithm a => Context a
hashInit

passthroughSizeSink :: (MonadIO m) => IORef Integer -> ConduitT ByteString ByteString m ()
passthroughSizeSink :: forall (m :: * -> *).
MonadIO m =>
IORef Integer -> ConduitT ByteString ByteString m ()
passthroughSizeSink IORef Integer
ioref = ConduitT ByteString Void m Integer
-> (Integer -> m ()) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i r.
Monad m =>
ConduitT i Void m r -> (r -> m ()) -> ConduitT i i m ()
passthroughSink ConduitT ByteString Void m Integer
forall (m :: * -> *) o.
MonadIO m =>
ConduitT ByteString o m Integer
sizeSink (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Integer -> IO ()) -> Integer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Integer -> Integer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Integer
ioref)

passthroughHashSinkBase :: (MonadIO m) => (Digest SHA256 -> ByteString) -> IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkBase :: forall (m :: * -> *).
MonadIO m =>
(Digest SHA256 -> ByteString)
-> IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkBase Digest SHA256 -> ByteString
f IORef ByteString
ioref = ConduitT ByteString Void m (Context SHA256)
-> (Context SHA256 -> m ()) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i r.
Monad m =>
ConduitT i Void m r -> (r -> m ()) -> ConduitT i i m ()
passthroughSink ConduitT ByteString Void m (Context SHA256)
forall (m :: * -> *) o.
MonadIO m =>
ConduitT ByteString o m (Context SHA256)
hashSink (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Context SHA256 -> IO ()) -> Context SHA256 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
ioref (ByteString -> IO ())
-> (Context SHA256 -> ByteString) -> Context SHA256 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
f (Digest SHA256 -> ByteString)
-> (Context SHA256 -> Digest SHA256)
-> Context SHA256
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA256 -> Digest SHA256
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize)

passthroughHashSink :: (MonadIO m) => IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSink :: forall (m :: * -> *).
MonadIO m =>
IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSink = (Digest SHA256 -> ByteString)
-> IORef ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
(Digest SHA256 -> ByteString)
-> IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkBase Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

passthroughHashSinkB16 :: (MonadIO m) => IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkB16 :: forall (m :: * -> *).
MonadIO m =>
IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkB16 = (Digest SHA256 -> ByteString)
-> IORef ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
(Digest SHA256 -> ByteString)
-> IORef ByteString -> ConduitT ByteString ByteString m ()
passthroughHashSinkBase (Base -> Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16)