content: {-- | An opaque handle to a keystore, used to read and write 'EncryptedSecretKey'
        from/to disk.
  
      NOTE: This module aims to provide a stable interface with a concrete
      implementation concealed by the user of this module. The internal operations
      are currently quite inefficient, as they have to work around the legacy
      'UserSecret' storage.
  
  --}
  
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  
  module Cardano.Wallet.Kernel.Keystore (
        Keystore -- opaque
      , DeletePolicy(..)
      , ReplaceResult(..)
        -- * Constructing a keystore
      , bracketKeystore
      , bracketLegacyKeystore
      , readWalletSecret
      -- * Inserting values
      , insert
      -- * Replacing values, atomically
      , compareAndReplace
      -- * Deleting values
      , delete
      -- * Queries on a keystore
      , getKeys
      , lookup
      -- * Tests handy functions
      , bracketTestKeystore
      ) where
  
  import           Universum
  
  import qualified Data.List
  import           System.Directory (getTemporaryDirectory, removeFile)
  import           System.IO (hClose, openTempFile)
  
  import           Pos.Core.NetworkMagic (NetworkMagic)
  import           Pos.Crypto (EncryptedSecretKey, hash)
  import           Pos.Util.Trace (fromTypeclassWlog)
  import           Pos.Util.UserSecret (UserSecret, getUSPath, isEmptyUserSecret,
                       readUserSecret, takeUserSecret, usKeys, usWallet,
                       writeRaw, writeUserSecretRelease, _wusRootKey)
  import           Pos.Util.Wlog (addLoggerName)
  
  import           Cardano.Wallet.Kernel.DB.HdWallet (eskToHdRootId)
  import           Cardano.Wallet.Kernel.Types (WalletId (..))
  import qualified Cardano.Wallet.Kernel.Util.Strict as Strict
  
  -- Internal storage necessary to smooth out the legacy 'UserSecret' API.
  data InternalStorage = InternalStorage !UserSecret
  
  -- | We are not really interested in fully-forcing the 'UserSecret'. We are
  -- happy here with the operations on the keystore being applied not lazily.
  instance NFData InternalStorage where
      rnf x = x `seq` ()
  
  -- A 'Keystore'.
  data Keystore = Keystore (Strict.MVar InternalStorage)
  
  -- | A 'DeletePolicy' is a preference the user can express on how to release
  -- the 'Keystore' during its teardown.
  data DeletePolicy =
        RemoveKeystoreIfEmpty
        -- ^ Completely obliterate the 'Keystore' if is empty, including the
        -- file on disk.
      | KeepKeystoreIfEmpty
        -- ^ Release the 'Keystore' without touching its file on disk, even
        -- if the latter is empty.
  
  {-------------------------------------------------------------------------------
    Creating a keystore
  -------------------------------------------------------------------------------}
  
  -- FIXME [CBR-316] Due to the current, legacy 'InternalStorage' being
  -- used, the 'Keystore' does not persist the in-memory content on disk after
  -- every destructive operations, which means that in case of a node crash or
  -- another catastrophic behaviour (e.g. power loss, etc) the in-memory content
  -- not yet written in memory will be forever lost.
  
  -- | Creates a 'Keystore' using a 'bracket' pattern, where the
  -- initalisation and teardown of the resource are wrapped in 'bracket'.
  bracketKeystore :: DeletePolicy
                  -- ^ What to do if the keystore is empty
                  -> FilePath
                  -- ^ The path to the file which will be used for the 'Keystore'
                  -> (Keystore -> IO a)
                  -- ^ An action on the 'Keystore'.
                  -> IO a
  bracketKeystore deletePolicy fp withKeystore =
      bracket (newKeystore fp) (releaseKeystore deletePolicy) withKeystore
  
  -- | Creates a new keystore.
  newKeystore :: FilePath -> IO Keystore
  newKeystore fp = do
      us <- takeUserSecret fromTypeclassWlog fp
      Keystore <$> Strict.newMVar (InternalStorage us)
  
  -- | Reads the legacy root key stored in the specified keystore. This is
  -- useful only for importing a wallet using the legacy '.key' format.
  readWalletSecret :: FilePath
                   -- ^ The path to the file which will be used for the 'Keystore'
                   -> IO (Maybe EncryptedSecretKey)
  readWalletSecret fp =
      addLoggerName "KeyStore" $
      importKeystore >>= lookupLegacyRootKey
    where
      lookupLegacyRootKey :: Keystore -> IO (Maybe EncryptedSecretKey)
      lookupLegacyRootKey (Keystore ks) =
          Strict.withMVar ks $ \(InternalStorage us) ->
              case us ^. usWallet of
                   Nothing -> return Nothing
                   Just w  -> return (Just $ _wusRootKey w)
  
      importKeystore :: IO Keystore
      importKeystore = do
          us <- readUserSecret fromTypeclassWlog fp
          Keystore <$> Strict.newMVar (InternalStorage us)
  
  
  
  -- | Creates a legacy 'Keystore' by reading the 'UserSecret' from a 'NodeContext'.
  -- Hopefully this function will go in the near future.
  newLegacyKeystore :: UserSecret -> IO Keystore
  newLegacyKeystore us = Keystore <$> Strict.newMVar (InternalStorage us)
  
  -- | Creates a legacy 'Keystore' using a 'bracket' pattern, where the
  -- initalisation and teardown of the resource are wrapped in 'bracket'.
  -- For a legacy 'Keystore' users do not get to specify a 'DeletePolicy', as
  -- the release of the keystore is left for the node and the legacy code
  -- themselves.
  bracketLegacyKeystore :: UserSecret -> (Keystore -> IO a) -> IO a
  bracketLegacyKeystore us withKeystore =
      bracket (newLegacyKeystore us)
              (\_ -> return ()) -- Leave teardown to the legacy wallet
              withKeystore
  
  bracketTestKeystore :: (Keystore -> IO a) -> IO a
  bracketTestKeystore withKeystore =
      bracket newTestKeystore
              (releaseKeystore RemoveKeystoreIfEmpty)
              withKeystore
  
  -- | Creates a 'Keystore' out of a randomly generated temporary file (i.e.
  -- inside your $TMPDIR of choice).
  -- We don't offer a 'bracket' style here as the teardown is irrelevant, as
  -- the file is disposed automatically from being created into the
  -- OS' temporary directory.
  -- NOTE: This 'Keystore', as its name implies, shouldn't be using in
  -- production, but only for testing, as it can even possibly contain data
  -- races due to the fact its underlying file is stored in the OS' temporary
  -- directory.
  newTestKeystore :: IO Keystore
  newTestKeystore = do
      tempDir         <- getTemporaryDirectory
      (tempFile, hdl) <- openTempFile tempDir "keystore.key"
      hClose hdl
      us <- takeUserSecret fromTypeclassWlog tempFile
      Keystore <$> Strict.newMVar (InternalStorage us)
  
  -- | Release the resources associated with this 'Keystore'.
  releaseKeystore :: DeletePolicy -> Keystore -> IO ()
  releaseKeystore dp (Keystore ks) =
      -- We are not modifying the 'MVar' content, because this function is
      -- not exported and called exactly once from the bracket de-allocation.
      Strict.withMVar ks $ \internalStorage@(InternalStorage us) -> do
          fp <- release internalStorage
          case dp of
               KeepKeystoreIfEmpty   -> return ()
               RemoveKeystoreIfEmpty ->
                   when (isEmptyUserSecret us) $ removeFile fp
  
  -- | Releases the underlying 'InternalStorage' and returns the updated
  -- 'InternalStorage' and the file on disk this storage lives in.
  -- 'FilePath'.
  release :: InternalStorage -> IO FilePath
  release (InternalStorage us) = do
      let fp = getUSPath us
      writeUserSecretRelease us
      return fp
  
  {-------------------------------------------------------------------------------
    Modifying the Keystore
    We wrap each operation which modifies the underlying `InternalStorage` into
    a combinator which also writes the updated `UserSecret` to file.
  -------------------------------------------------------------------------------}
  
  -- | Modifies the 'Keystore' by applying the transformation 'f' on the
  -- underlying 'UserSecret'.
  modifyKeystore_ :: Keystore -> (UserSecret -> UserSecret) -> IO ()
  modifyKeystore_ ks f =
      let f' us = (f us, ())
      in modifyKeystore ks f'
  
  -- | Like 'modifyKeystore_', but it returns a result at the end.
  modifyKeystore :: Keystore -> (UserSecret -> (UserSecret, a)) -> IO a
  modifyKeystore (Keystore ks) f =
      Strict.modifyMVar ks $ \(InternalStorage us) -> do
          let (us', a) = f us
          -- This is a safe operation to be because we acquired the exclusive
          -- lock on this file when we initialised the keystore, and as we are
          -- using 'bracket', we are the sole owner of this lock.
          writeRaw us'
          return (InternalStorage us', a)
  
  {-------------------------------------------------------------------------------
    Inserting things inside a keystore
  -------------------------------------------------------------------------------}
  
  -- | Insert a new 'EncryptedSecretKey' indexed by the input 'WalletId'.
  insert :: WalletId -> EncryptedSecretKey -> Keystore -> IO ()
  insert _walletId esk ks = modifyKeystore_ ks (insertKey esk)
  
  -- | Insert a new 'EncryptedSecretKey' directly inside the 'UserSecret'.
  insertKey :: EncryptedSecretKey -> UserSecret -> UserSecret
  insertKey esk us =
      if view usKeys us `contains` esk
          then us
          else us & over usKeys (esk :)
      where
        -- Comparator taken from the old code which needs to hash
        -- all the 'EncryptedSecretKey' in order to compare them.
        contains :: [EncryptedSecretKey] -> EncryptedSecretKey -> Bool
        contains ls k = hash k `elem` map hash ls
  
  
  -- | An enumeration
  data ReplaceResult =
        Replaced
      | OldKeyLookupFailed
      | PredicateFailed
      -- ^ The supplied predicate failed.
      deriving (Show, Eq)
  
  -- | Replace an old 'EncryptedSecretKey' with a new one,
  -- verifying a pre-condition on the previously stored key.
  compareAndReplace :: NetworkMagic
                    -> WalletId
                    -> (EncryptedSecretKey -> Bool)
                    -> EncryptedSecretKey
                    -> Keystore
                    -> IO ReplaceResult
  compareAndReplace nm walletId predicateOnOldKey newKey ks =
      modifyKeystore ks $ \us ->
          let mbOldKey = lookupKey nm us walletId
          in case predicateOnOldKey <$> mbOldKey of
                Nothing    ->
                    (us, OldKeyLookupFailed)
                Just False ->
                    (us, PredicateFailed)
                Just True  ->
                    (insertKey newKey . deleteKey nm walletId $ us, Replaced)
  
  {-------------------------------------------------------------------------------
    Looking up things inside a keystore
  -------------------------------------------------------------------------------}
  
  -- | Lookup an 'EncryptedSecretKey' associated to the input 'HdRootId'.
  lookup :: NetworkMagic
         -> WalletId
         -> Keystore
         -> IO (Maybe EncryptedSecretKey)
  lookup nm wId (Keystore ks) =
      Strict.withMVar ks $ \(InternalStorage us) -> return $ lookupKey nm us wId
  
  -- | Lookup a key directly inside the 'UserSecret'.
  lookupKey :: NetworkMagic -> UserSecret -> WalletId -> Maybe EncryptedSecretKey
  lookupKey nm us (WalletIdHdRnd walletId) =
      Data.List.find (\k -> eskToHdRootId nm k == walletId) (us ^. usKeys)
  
  -- | Return all Keystore 'usKeys'
  getKeys :: Keystore -> IO [EncryptedSecretKey]
  getKeys (Keystore ks) =
      Strict.withMVar ks $ \(InternalStorage us) -> return $ us ^. usKeys
  
  {-------------------------------------------------------------------------------
    Deleting things from the keystore
  -------------------------------------------------------------------------------}
  
  -- | Deletes an element from the 'Keystore'. This is an idempotent operation
  -- as in case a key was not present, no error would be thrown.
  delete :: NetworkMagic -> WalletId -> Keystore -> IO ()
  delete nm walletId ks = modifyKeystore_ ks (deleteKey nm walletId)
  
  -- | Delete a key directly inside the 'UserSecret'.
  deleteKey :: NetworkMagic -> WalletId -> UserSecret -> UserSecret
  deleteKey nm walletId us =
      let mbEsk = lookupKey nm us walletId
          erase = Data.List.deleteBy (\a b -> hash a == hash b)
      in maybe us (\esk -> us & over usKeys (erase esk)) mbEsk
  