[ADP-322] Suggestions for PR #4555 (#4645)

This PR contains suggestions for PR #4555.
cardano-foundation · Jun 26, 2024 · 0bb3ed6 · 0bb3ed6
2 parents 0e2ea8d + e12b1e1
commit 0bb3ed6
Showing 1 changed file with 51 additions and 48 deletions.
diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs
@@ -729,7 +729,8 @@ import Control.Tracer
     , contramap
     )
 import Cryptography.Cipher.AES256CBC
-    ( CipherMode (..)
+    ( CipherError
+    , CipherMode (..)
     )
 import Cryptography.Core
     ( genSalt
@@ -3188,10 +3189,8 @@ toMetadataEncrypted
     -> TxMetadataWithSchema
     -> Maybe ByteString
     -> Either ErrConstructTx TxMetadata
-toMetadataEncrypted apiEncrypt payload saltM = do
-    msgValue <- findMsgValue
-    msgValue' <- encryptingMsg msgValue
-    pure $ updateTxMetadata msgValue'
+toMetadataEncrypted apiEncrypt payload saltM =
+    fmap updateTxMetadata . encryptMessage =<< extractMessage
   where
     pwd :: ByteString
     pwd = BA.convert $ unPassphrase $ getApiT $ apiEncrypt ^. #passphrase
@@ -3200,64 +3199,68 @@ toMetadataEncrypted apiEncrypt payload saltM = do
     (secretKey, iv) = PBKDF2.generateKey metadataPBKDF2Config pwd saltM
 
     -- `msg` is not embedded beyond the first level
-    inspectMetaPair :: TxMetadataValue -> Maybe TxMetadataValue
-    inspectMetaPair = \case
+    parseMessage :: TxMetadataValue -> Maybe TxMetadataValue
+    parseMessage = \case
         TxMetaMap kvs ->
-            case mapMaybe getMsgValue kvs of
+            case mapMaybe getValue kvs of
                 [ ] -> Nothing
                 [v] -> Just v
                 _vs -> error "only one 'msg' field expected"
         _ ->
             Nothing
       where
-        getMsgValue
-            :: (TxMetadataValue, TxMetadataValue) -> Maybe TxMetadataValue
-        getMsgValue (TxMetaText "msg", v) = Just v
-        getMsgValue _ = Nothing
+        getValue :: (TxMetadataValue, TxMetadataValue) -> Maybe TxMetadataValue
+        getValue (TxMetaText "msg", v) = Just v
+        getValue _ = Nothing
 
-    keyAndValueCond :: Word64 -> TxMetadataValue -> Bool
-    keyAndValueCond k v =
-        k == cip20MetadataKey && isJust (inspectMetaPair v)
+    validKeyAndMessage :: Word64 -> TxMetadataValue -> Bool
+    validKeyAndMessage k v = k == cip20MetadataKey && isJust (parseMessage v)
 
-    findMsgValue :: Either ErrConstructTx TxMetadataValue
-    findMsgValue
+    extractMessage :: Either ErrConstructTx TxMetadataValue
+    extractMessage
         | [v] <- F.toList filteredMap =
             Right v
         | otherwise =
             Left ErrConstructTxIncorrectRawMetadata
       where
         TxMetadata themap = payload ^. #txMetadataWithSchema_metadata
-        filteredMap = Map.filterWithKey keyAndValueCond themap
-
-    encryptPairIfQualifies
-        :: (TxMetadataValue, TxMetadataValue)
-        -> Either ErrConstructTx [(TxMetadataValue, TxMetadataValue)]
-    encryptPairIfQualifies = \case
-        (TxMetaText "msg", metaValue) ->
-            bimap ErrConstructTxEncryptMetadata toPair
-                $ AES256CBC.encrypt WithPadding secretKey iv saltM
-                $ BL.toStrict
-                $ Aeson.encode
-                $ Cardano.metadataValueToJsonNoSchema metaValue
-          where
-            toPair encryptedMessage =
-                [ (TxMetaText "msg", TxMetaList (toChunks encryptedMessage))
-                , (TxMetaText "enc", TxMetaText "basic")
-                ]
-            toChunks
-                = fmap TxMetaText
-                . T.chunksOf 64
-                . T.decodeUtf8
-                . convertToBase Base64
-        pair ->
-            Right [pair]
-
-    encryptingMsg :: TxMetadataValue -> Either ErrConstructTx TxMetadataValue
-    encryptingMsg = \case
-        TxMetaMap pairs -> do
-            pairs' <- mapM encryptPairIfQualifies pairs
-            pure (TxMetaMap $ concat pairs')
-        _ -> error "encryptingMsg should have TxMetaMap value"
+        filteredMap = Map.filterWithKey validKeyAndMessage themap
+
+    encryptMessage :: TxMetadataValue -> Either ErrConstructTx TxMetadataValue
+    encryptMessage = \case
+        TxMetaMap pairs ->
+            TxMetaMap . concat <$> mapM encryptPairIfQualifies pairs
+        _ ->
+            error "encryptMessage should have TxMetaMap value"
+      where
+        encryptPairIfQualifies
+            :: (TxMetadataValue, TxMetadataValue)
+            -> Either ErrConstructTx [(TxMetadataValue, TxMetadataValue)]
+        encryptPairIfQualifies = \case
+            (TxMetaText "msg", m) ->
+                bimap ErrConstructTxEncryptMetadata toPair (encryptValue m)
+            pair ->
+                Right [pair]
+
+        encryptValue :: TxMetadataValue -> Either CipherError ByteString
+        encryptValue
+            = AES256CBC.encrypt WithPadding secretKey iv saltM
+            . BL.toStrict
+            . Aeson.encode
+            . Cardano.metadataValueToJsonNoSchema
+
+        toPair :: ByteString -> [(TxMetadataValue, TxMetadataValue)]
+        toPair encryptedMessage =
+            [ (TxMetaText "msg", TxMetaList (toChunks encryptedMessage))
+            , (TxMetaText "enc", TxMetaText "basic")
+            ]
+
+        toChunks :: ByteString -> [TxMetadataValue]
+        toChunks
+            = fmap TxMetaText
+            . T.chunksOf 64
+            . T.decodeUtf8
+            . convertToBase Base64
 
     updateTxMetadata :: TxMetadataValue -> W.TxMetadata
     updateTxMetadata v = TxMetadata (Map.insert cip20MetadataKey v themap)