{- - This Source Code Form is subject to the terms of the Mozilla Public - License, v. 2.0. If a copy of the MPL was not distributed with this - file, You can obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE OverloadedStrings #-} module Test.System.Win32.Dpapi (dpapiTests) where import Data.Base64.Types (extractBase64) import Data.ByteString (toStrict) import Data.ByteString.Base64 (decodeBase64Untyped, encodeBase64) import Data.ByteString.Lazy (ByteString, dropWhileEnd) import Data.Char (chr, isSpace) import Data.Text (unpack) import System.Process.Typed ( ExitCode (ExitSuccess), nullStream, proc, readProcessStdout, setStderr, ) import System.Win32.Dpapi ( DataProtectionScope (CurrentUser, LocalMachine), cryptProtectData, cryptUnprotectData, cryptUnprotectDataCheck, ) import Test.HUnit dpapiTests :: Test dpapiTests = "System.Win32.Dpapi" ~: [testProtectCurrentUser, testProtectLocalMachine, testUnprotectCurrentUser, testUnprotectLocalMachine, testUnprotectLocalMachineMaybe, testUnprotectError] testProtectCurrentUser :: Test testProtectCurrentUser = "testProtectCurrentUser" ~: do protected <- cryptProtectData "fizz" Nothing CurrentUser (exitCode, out) <- readProcessStdout $ setStderr nullStream $ proc "powershell" ["-c", "Add-Type -AssemblyName System.Security; [System.Text.Encoding]::UTF8.GetString([System.Security.Cryptography.ProtectedData]::Unprotect([System.Convert]::FromBase64String(\"" <> unpack (extractBase64 $ encodeBase64 protected) <> "\"), $null, [System.Security.Cryptography.DataProtectionScope]::CurrentUser))"] assertEqual "powershell exit code" ExitSuccess exitCode let out' = trimEndBs out out' @?= "fizz" testProtectLocalMachine :: Test testProtectLocalMachine = "testProtectLocalMachine" ~: do protected <- cryptProtectData "buzz" Nothing LocalMachine (exitCode, out) <- readProcessStdout $ setStderr nullStream $ proc "powershell" ["-c", "Add-Type -AssemblyName System.Security; [System.Text.Encoding]::UTF8.GetString([System.Security.Cryptography.ProtectedData]::Unprotect([System.Convert]::FromBase64String(\"" <> unpack (extractBase64 $ encodeBase64 protected) <> "\"), $null, [System.Security.Cryptography.DataProtectionScope]::LocalMachine))"] assertEqual "powershell exit code" ExitSuccess exitCode let out' = trimEndBs out out' @?= "buzz" testUnprotectCurrentUser :: Test testUnprotectCurrentUser = "testUnprotectCurrentUser" ~: do (exitCode, out) <- readProcessStdout $ setStderr nullStream $ proc "powershell" ["-c", "Add-Type -AssemblyName System.Security; [System.Convert]::ToBase64String([System.Security.Cryptography.ProtectedData]::Protect([System.Text.Encoding]::UTF8.GetBytes(\"foo\"), $null, [System.Security.Cryptography.DataProtectionScope]::CurrentUser))"] assertEqual "powershell exit code" ExitSuccess exitCode let out' = toStrict $ trimEndBs out -- Powershell outputs \r\n even when it's not wanted case decodeBase64Untyped out' of l@(Left _) -> Right out' @?= l Right bs -> do result <- cryptUnprotectData bs Nothing CurrentUser result @?= "foo" testUnprotectLocalMachine :: Test testUnprotectLocalMachine = "testUnprotectLocalMachine" ~: do (exitCode, out) <- readProcessStdout $ setStderr nullStream $ proc "powershell" ["-c", "Add-Type -AssemblyName System.Security; [System.Convert]::ToBase64String([System.Security.Cryptography.ProtectedData]::Protect([System.Text.Encoding]::UTF8.GetBytes(\"bar\"), $null, [System.Security.Cryptography.DataProtectionScope]::LocalMachine))"] assertEqual "powershell exit code" ExitSuccess exitCode let out' = toStrict $ trimEndBs out -- Powershell outputs \r\n even when it's not wanted case decodeBase64Untyped out' of l@(Left _) -> Right out' @?= l Right bs -> do result <- cryptUnprotectData bs Nothing LocalMachine result @?= "bar" testUnprotectLocalMachineMaybe :: Test testUnprotectLocalMachineMaybe = "testUnprotectLocalMachine" ~: do (exitCode, out) <- readProcessStdout $ setStderr nullStream $ proc "powershell" ["-c", "Add-Type -AssemblyName System.Security; [System.Convert]::ToBase64String([System.Security.Cryptography.ProtectedData]::Protect([System.Text.Encoding]::UTF8.GetBytes(\"bar\"), $null, [System.Security.Cryptography.DataProtectionScope]::LocalMachine))"] assertEqual "powershell exit code" ExitSuccess exitCode let out' = toStrict $ trimEndBs out -- Powershell outputs \r\n even when it's not wanted case decodeBase64Untyped out' of l@(Left _) -> Right out' @?= l Right bs -> do result <- cryptUnprotectDataCheck bs Nothing LocalMachine result @?= Just "bar" testUnprotectError :: Test testUnprotectError = "testUnprotectError" ~: do result <- cryptUnprotectDataCheck ciphertext Nothing CurrentUser result @?= Nothing where ciphertext = case decodeBase64Untyped "AQAAANCMnd8BFdERjHoAwE/Cl+sBAAAA8Zcdtib+QkybE9Tbcq0/EwQAAAACAAAAAAAQZgAAAAEAACAAAAB5qoj4OynizB5iEVZvAtyEZlVVn2RjP4SdHz5dOnIjYAAAAAAOgAAAAAIAACAAAAAGKRerRiwIK/xPPH8NtVhAxU9dg2qfcNsxLg+wtYml8RAAAADinEDleLmnP+qGkSpqgeZ9QAAAAAmaXs8XjSezA4qSWIFL3HD2bqd757HNPfXfuBz4eVYtfRawfRpFXFTmfIh+2nOzf1N2IYH44fBK7VrW+ITOZ74=" of (Right c) -> c (Left _) -> error "Programming error! Base64 text wasn't!" trimEndBs :: ByteString -> ByteString trimEndBs = dropWhileEnd (isSpace . chr . fromIntegral)