From bdfbe453aa507c1b61d8cdc2dd4064d70a4fd01b Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Thu, 12 Jan 2023 17:01:43 +0100 Subject: [PATCH 01/12] initial draft of secure wallet, need to Haskell-ify it --- EnclaveIFC.cabal | 17 ++ app/Main.hs | 221 +++++++++++++++++++++----- examples/SecureWallet/SecureWallet.hs | 189 ++++++++++++++++++++++ src/Client.hs | 11 ++ src/Server.hs | 35 +++- 5 files changed, 431 insertions(+), 42 deletions(-) create mode 100644 examples/SecureWallet/SecureWallet.hs diff --git a/EnclaveIFC.cabal b/EnclaveIFC.cabal index 7450e37..8475685 100644 --- a/EnclaveIFC.cabal +++ b/EnclaveIFC.cabal @@ -71,6 +71,23 @@ executable EnclaveIFC-exe cpp-options: -DUMMY default-language: Haskell2010 +executable SecureWallet-exe + main-is: SecureWallet.hs + hs-source-dirs: examples/SecureWallet + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -main-is SecureWallet + build-depends: + EnclaveIFC + , base >=4.7 && <5 + , binary + , bytestring + , network-simple + , transformers + if (flag(enclave)) + cpp-options: -DENCLAVE + else + cpp-options: -DUMMY + default-language: Haskell2010 + test-suite EnclaveIFC-test type: exitcode-stdio-1.0 main-is: Spec.hs diff --git a/app/Main.hs b/app/Main.hs index 4eec4d5..61f0075 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,66 +2,205 @@ module Main where import Control.Monad.IO.Class(liftIO) -import Data.List(genericLength) -import GHC.Float(int2Float) +import System.IO +import Text.Read + import App #ifdef ENCLAVE -import Server +import Server as API #else -import Client +import Client as API #endif +-- * Return codes + +retSuccess, passwordOutOfRange, walletAlreadyExists :: Int +retSuccess = 0 +passwordOutOfRange = 1 +walletAlreadyExists = 2 + +cannotSaveWallet, cannotLoadWallet, wrongMasterPassword :: Int +cannotSaveWallet = 3 +cannotLoadWallet = 4 +wrongMasterPassword = 5 + +walletFull, itemDoesNotExist, itemTooLong, failSeal, failUnseal :: Int +walletFull = 6 +itemDoesNotExist = 7 +itemTooLong = 8 +failSeal = 9 +failUnseal = 10 + +-- * Static values + +maxItems :: Int +maxItems = 100 + +maxItemSize :: Int +maxItemSize = 100 + +wallet :: String +wallet = "wallet.seal" + +-- * Data types + +data Item = Item + { title :: String + , username :: String + , password :: String + } + deriving (Show, Read) +data Wallet = Wallet + { items :: [Item] + , size :: Int + , masterPassword :: String + } + deriving (Show, Read) -getData :: Server (Ref (Sec [Int])) -> Int -> Server Int -getData serv_secret idx = do - secret <- serv_secret - sech <- readRef secret - let sec_i = fmap (\s -> s !! idx) sech - return (declassify sec_i) +newWallet :: Password -> Wallet +newWallet mp = Wallet [] 0 mp -releaseAvg :: Server (Ref Bool) -> Server () -releaseAvg sbool = do - bool <- sbool - writeRef bool True +type Password = String -doAvg :: [Int] -> Float -doAvg xs = realToFrac (sum xs) / genericLength xs +-- * Enclave code -getAvg :: Server (Ref Bool) -> Server (Ref (Sec [Int])) -> Server Float -getAvg serv_bool serv_secret = do - bool <- serv_bool - secret <- serv_secret - b <- readRef bool +passwordPolicy :: Password -> Bool +passwordPolicy pass = length pass >= 8 && length pass + 1 <= maxItemSize + +loadWallet :: Server (Maybe Wallet) +loadWallet = do + b <- API.doesFileExist wallet + unsafePrint (show b) if b - then do - s <- readRef secret - let s' = declassify s - let avg = doAvg s' - return avg - else return 0.0 + then do contents <- API.readFile wallet + return $ (readMaybe contents :: Maybe Wallet) + else return Nothing + +saveWallet :: Wallet -> Server () +saveWallet w = API.writeFile wallet (show w) + +createWallet :: Password -> Server Int +createWallet mp + | not $ passwordPolicy mp = return passwordOutOfRange + | otherwise = do + w <- loadWallet + case w of + Just _ -> return walletAlreadyExists + Nothing -> saveWallet (newWallet mp) >> return retSuccess + +changeMasterPassword :: Password -> Password -> Server Int +changeMasterPassword old new + | not $ passwordPolicy new = return passwordOutOfRange + | otherwise = do + w <- loadWallet + case w of + Nothing -> return cannotLoadWallet + Just w -> if masterPassword w == old + then saveWallet (w { masterPassword = new }) >> return retSuccess + else return wrongMasterPassword + +addItem :: Password -> String -> String -> Password -> Server Int +addItem mp item username pass + | length item + 1 > maxItemSize || + length username + 1 > maxItemSize || + length pass + 1 > maxItemSize = return itemTooLong + | otherwise = do + w <- loadWallet + case w of + Nothing -> return cannotLoadWallet + Just w -> + if masterPassword w == mp + -- FIXME check if item already exists + then saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) >> return retSuccess + else return wrongMasterPassword +removeItem :: Password -> String -> Server Int +removeItem mp item = do + w <- loadWallet + case w of + Nothing -> return cannotLoadWallet + Just w | not (item `elem` (map title (items w))) -> return itemDoesNotExist + Just w | not (masterPassword w == mp) -> return wrongMasterPassword + Just w -> saveWallet (w { items = filter (not . (==) item . title) (items w), size = size w - 1}) >> return retSuccess -printCl :: String -> Client () -printCl = liftIO . putStrLn +-- * The application + +data Api = Api + { create :: Remote (Password -> Server Int) + , changePass :: Remote (Password -> Password -> Server Int) + , add :: Remote (Password -> String -> String -> Password -> Server Int) + , remove :: Remote (Password -> String -> Server Int) + } app :: App Done app = do - remoteSec1 <- liftNewRef (sec [15,30,11,6]) :: App (Server (Ref (Sec [Int]))) - remoteSec2 <- liftNewRef False :: App (Server (Ref Bool)) - gD <- remote $ getData remoteSec1 - rA <- remote $ releaseAvg remoteSec2 - gA <- remote $ getAvg remoteSec2 remoteSec1 - runClient $ do - data1 <- onServer (gD <.> 3) - _ <- onServer rA - avg <- onServer gA - let b = dummyCompOnData data1 avg - printCl $ "Is data less than avg? " <> show b + -- The api + create <- remote $ createWallet + changePass <- remote $ changeMasterPassword + add <- remote $ addItem + remove <- remote $ removeItem + + -- Client code + runClient $ clientApp $ Api create changePass add remove + +data Command + = Create + | Change Password Password + | Add String String Password + | Remove String + | Shutoff + deriving Show + +clientApp :: Api -> Client () +clientApp api = do + cmd <- getCommand + case cmd of + Shutoff -> liftIO (putStrLn "turning off...") >> return () + _ -> do liftIO $ hPutStr stdout "master password: " + liftIO $ hFlush stdout + mp <- liftIO $ getLine + r <- onServer $ case cmd of + Create -> create api <.> mp + Change old new -> changePass api <.> old <.> new + Add title username password -> add api <.> mp <.> title <.> username <.> password + Remove title -> remove api <.> mp <.> title + printCode r + +getCommand :: Client Command +getCommand = do + liftIO $ hPutStr stdout "> " + liftIO $ hFlush stdout + input <- liftIO $ getLine + case input of + [] -> getCommand + s -> case tryParse s of + Just c -> return c + Nothing -> getCommand where - dummyCompOnData i av = int2Float i < av + tryParse :: String -> Maybe Command + tryParse input = case words input of + ["create"] -> Just Create + ["change", old, new] -> Just $ Change old new + ["add", title, username, password] -> Just $ Add title username password + ["remove", title] -> Just $ Remove title + ["shutoff"] -> Just Shutoff + otherwise -> Nothing +printCode :: Int -> Client () +printCode c + | c == retSuccess = liftIO $ putStrLn $ "# ok" + | c == passwordOutOfRange = liftIO $ putStrLn $ "= password out of range" + | c == walletAlreadyExists = liftIO $ putStrLn $ "= wallet already exists" + | c == cannotSaveWallet = liftIO $ putStrLn $ "= cannot save wallet" + | c == cannotLoadWallet = liftIO $ putStrLn $ "= cannot load wallet" + | c == wrongMasterPassword = liftIO $ putStrLn $ "= wrong master password" + | c == walletFull = liftIO $ putStrLn $ "= wallet is full" + | c == itemDoesNotExist = liftIO $ putStrLn $ "= item does not exist" + | c == itemTooLong = liftIO $ putStrLn $ "= item is too long" + | c == failSeal = liftIO $ putStrLn $ "= failure while sealing wallet" + | c == failUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" main :: IO () main = do diff --git a/examples/SecureWallet/SecureWallet.hs b/examples/SecureWallet/SecureWallet.hs new file mode 100644 index 0000000..7bae918 --- /dev/null +++ b/examples/SecureWallet/SecureWallet.hs @@ -0,0 +1,189 @@ +module SecureWallet where + +import App + +#ifdef ENCLAVE +import Server +#else +import Client +#endif + +-- * Return codes + +retSuccess, passwordOutOfRange, walletAlreadyExists :: Int +retSuccess = 0 +passwordOutOfRange = 1 +walletAlreadyExists = 2 + +cannotSaveWallet, cannotLoadWallet, wrongMasterPassword :: Int +cannotSaveWallet = 3 +cannotLoadWallet = 4 +wrongMasterPassword = 5 + +walletFull, itemDoesNotExist, itemTooLong, failSeal, failUnseal :: Int +walletFull = 6 +itemDoesNotExist = 7 +itemTooLong = 8 +failSeal = 9 +failUnseal = 10 + +-- * Static values + +maxItems :: Int +maxItems = 100 + +maxItemSize :: Int +maxItemSize = 100 + +wallet :: String +wallet = "wallet.seal" + +-- * Data types + +data Item = Item + { title :: String + , username :: String + , password :: String + } + +data Wallet = Wallet + { items :: [Item] + , size :: Int + , masterPassword :: String + } + +newWallet :: Password -> Wallet +newWallet mp = Wallet [] 0 mp + +type Password = String + +-- * Enclave code + +passwordPolicy :: Password -> Bool +passwordPolicy pass = length pass >= 8 && length pass + 1 <= maxItemSize + +createWallet :: Server (Ref (Maybe Wallet)) -> Password -> Server Int +createWallet srw mp + | not $ passwordPolicy mp = return passwordOutOfRange + | otherwise = do + w <- readRef =<< srw + case w of + Just _ -> return walletAlreadyExists + Nothing -> srw >>= \r -> writeRef r (Just $ newWallet mp) >> return retSuccess + +changeMasterPassword :: Server (Ref (Maybe Wallet)) -> Password -> Password -> Server Int +changeMasterPassword srw old new + | not $ passwordPolicy new = return passwordOutOfRange + | otherwise = do + w <- readRef =<< srw + if masterPassword w == old + then do r <- srw + writeRef r (Just $ w { masterPassword = new }) + return retSuccess + else return wrongMasterPassword + +addItem :: Server (Ref (Maybe Wallet)) -> Password -> String -> String -> Password -> Server Int +addItem srw mp item username pass + | length item + 1 > maxItemSize || + length username + 1 > maxItemSize || + length password + 1 > maxItemSize = return itemTooLong + | otherwise = do + w <- readRef =<< srw + case w of + Nothing -> return cannotLoadWallet + Just w -> + if masterPassword w == mp + then do r <- srw + writeRef r (Just $ w { items = (Item item username pass) : items w, size = size w + 1}) + return retSuccess + else return wrongMasterPassword + +removeItem :: Server (Ref (Maybe Wallet)) -> Password -> String -> Server Int +removeItem srw mp item = do + w <- readRef =<< srw + case w of + Nothing -> return cannotLoadWallet + Just w | not (item `elem` (map title (items w))) -> return itemDoesNotExist + Just w | not (masterPassword w == mp) -> return wrongMasterPassword + Just w -> do r <- srw + writeRef r $ Just $ w { items = filter (not . (==) item . title) items, size = size w - 1} + return retSuccess + +-- * The application + +data Api = Api + { create :: Server Int + , changePass :: Password -> Password -> Server Int + , add :: String -> String -> Password -> Server Int + , remove :: String -> Server Int} + +app :: App Done +app = do + -- The data + walletref <- liftNewRef Nothing + + -- The api + create <- remote $ createWallet walletref + changePass <- remote $ changeMasterPassword walletref + add <- remote $ addItem walletref + remove <- remote $ removeItem walletref + + -- Client code + runClient $ clientApp $ Api create changePass add remove + +data Command + = Create + | Change Password Password + | Add String String Password + | Remove String + | Shutoff + +clientApp :: Api -> Client () +clientApp api = do + cmd <- getCommand + case cmd of + Shutoff -> liftIO (putStrLn "turning off...") >> return () + _ -> r <- onServer $ case cmd of + Create -> create api + Change old new -> change api old new + Add title username password -> add api title username password + Remove title -> remove api title + printCode r + +getCommand :: Client Command +getCommand = do + liftIO $ putStr ">" + input <- liftIO $ getLine + case input of + [] -> getCommand + s -> case tryParse s of + Just c -> return C + Nothing -> getCommand + where + tryParse :: String -> Just Command + tryParse input = case words input of + ["create"] -> Just Create + ["change", old, new] -> Just $ Change old new + ["add", title, username, password] -> Just $ Add title username password + ["remote", title] -> Just $ Remove title + ["shutoff"] -> Just Shutoff + otherwise -> Nothing + +printCode :: Int -> Client () +printCode c + | c == retSuccess = liftIO $ putStrLn $ "# ok" + | c == passwordOutOfRange = liftIO $ putStrLn $ "= password out of range" + | c == walletAlreadyExists = liftIO $ putStrLn $ "= wallet already exists" + | c == cannotSaveWallet = liftIO $ putStrLn $ "= cannot save wallet" + | c == cannotLoadWallet = liftIO $ putStrLn $ "= cannot load wallet" + | c == wrongMasterPassword = liftIO $ putStrLn $ "= wrong master password" + | c == walletFull = liftIO $ putStrLn $ "= wallet is full" + | c == itemDoesNotExists = liftIO $ putStrLn $ "= item does not exist" + | c == itemTooLong = liftIO $ putStrLn $ "= item is too long" + | c == failSeal = liftIO $ putStrLn $ "= failure while sealing wallet" + | c == failUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" + +main :: IO () +main = do + res <- runApp app + return $ res `seq` () diff --git a/src/Client.hs b/src/Client.hs index 950f929..834dc1f 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -58,6 +58,17 @@ readRef _ = ServerDummy writeRef :: Ref a -> a -> Server () writeRef _ _ = ServerDummy +writeFile :: String -> String -> Server () +writeFile _ _ = ServerDummy + +readFile :: String -> Server String +readFile _ = ServerDummy + +doesFileExist :: String -> Server Bool +doesFileExist _ = ServerDummy + +unsafePrint :: String -> Server () +unsafePrint _ = ServerDummy type Client = IO diff --git a/src/Server.hs b/src/Server.hs index c4e0bbf..f5c1860 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -9,12 +9,13 @@ module Server(module Server) where import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.State.Strict +import Control.Exception import Data.Binary(Binary, encode, decode) import Data.ByteString.Lazy(ByteString) import Data.IORef import Data.Maybe import Network.Simple.TCP -import System.IO(hFlush, stdout) +import System.IO import App import qualified Data.ByteString.Lazy as B @@ -42,6 +43,8 @@ data Remote a = RemoteDummy serverConstant :: a -> App (Server a) serverConstant = return . return +-- * Reference management + liftNewRef :: a -> App (Server (Ref a)) liftNewRef a = App $ do r <- liftIO $ newIORef a @@ -56,6 +59,36 @@ readRef ref = Server $ readIORef ref writeRef :: Ref a -> a -> Server () writeRef ref v = Server $ writeIORef ref v +writeFile :: String -> String -> Server () +writeFile fp contents = Server (Prelude.writeFile fp contents) + +readFile :: String -> Server String +readFile fp = Server (do handle <- openFile fp ReadMode + contents <- hGetContents' handle + putStrLn $ show contents + hClose handle + return contents) + where + hGetContents' :: Handle -> IO String + hGetContents' h = do + eof <- hIsEOF h + if eof + then + return [] + else do + c <- hGetChar h + fmap (c:) $ hGetContents' h + +doesFileExist :: String -> Server Bool +doesFileExist fp = Server $ + (openFile fp ReadMode >>= hClose >> return True) `catch` \ex -> let e = ex :: SomeException + in return False + +unsafePrint :: String -> Server () +unsafePrint str = Server $ putStrLn str + +-- * Other stuff + remote :: (Remotable a) => a -> App (Remote a) remote f = App $ do (next_id, remotes) <- get From d39172baa692a12aa60e5837d64037a25c60a679 Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Fri, 13 Jan 2023 15:26:08 +0100 Subject: [PATCH 02/12] updated example --- app/Main.hs | 221 ++++++++++++++++++++++++++++++-------------------- client.sh | 5 +- src/Server.hs | 1 - 3 files changed, 135 insertions(+), 92 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 61f0075..f76fd41 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,9 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE CPP #-} module Main where import Control.Monad.IO.Class(liftIO) import System.IO import Text.Read +import Data.Binary +import GHC.Generics +import System.IO.Unsafe + import App @@ -15,22 +20,22 @@ import Client as API -- * Return codes -retSuccess, passwordOutOfRange, walletAlreadyExists :: Int -retSuccess = 0 -passwordOutOfRange = 1 -walletAlreadyExists = 2 - -cannotSaveWallet, cannotLoadWallet, wrongMasterPassword :: Int -cannotSaveWallet = 3 -cannotLoadWallet = 4 -wrongMasterPassword = 5 - -walletFull, itemDoesNotExist, itemTooLong, failSeal, failUnseal :: Int -walletFull = 6 -itemDoesNotExist = 7 -itemTooLong = 8 -failSeal = 9 -failUnseal = 10 +data ReturnCode + = Success + | PasswordOutOfRange + | WalletAlreadyExists + | CannotSaveWallet + | CannotLoadWallet + | WrongMasterPassword + | WalletFull + | ItemDoesNotExist + | ItemAlreadyExists + | ItemTooLong + | FailSeal + | FailUnseal + deriving Generic + +instance Binary ReturnCode -- * Static values @@ -72,84 +77,111 @@ passwordPolicy pass = length pass >= 8 && length pass + 1 <= maxItemSize loadWallet :: Server (Maybe Wallet) loadWallet = do b <- API.doesFileExist wallet - unsafePrint (show b) + let x = unsafePerformIO (putStrLn (show b)) + if x == () + then return () + else return () if b then do contents <- API.readFile wallet return $ (readMaybe contents :: Maybe Wallet) else return Nothing -saveWallet :: Wallet -> Server () -saveWallet w = API.writeFile wallet (show w) +saveWallet :: Wallet -> Server ReturnCode +saveWallet w = API.writeFile wallet (show w) >> return Success -createWallet :: Password -> Server Int +createWallet :: Password -> Server ReturnCode createWallet mp - | not $ passwordPolicy mp = return passwordOutOfRange + | not $ passwordPolicy mp = return PasswordOutOfRange | otherwise = do w <- loadWallet case w of - Just _ -> return walletAlreadyExists - Nothing -> saveWallet (newWallet mp) >> return retSuccess + Just _ -> return WalletAlreadyExists + Nothing -> saveWallet (newWallet mp) -changeMasterPassword :: Password -> Password -> Server Int +changeMasterPassword :: Password -> Password -> Server ReturnCode changeMasterPassword old new - | not $ passwordPolicy new = return passwordOutOfRange + | not $ passwordPolicy new = return PasswordOutOfRange | otherwise = do w <- loadWallet case w of - Nothing -> return cannotLoadWallet + Nothing -> return CannotLoadWallet Just w -> if masterPassword w == old - then saveWallet (w { masterPassword = new }) >> return retSuccess - else return wrongMasterPassword + then saveWallet (w { masterPassword = new }) + else return WrongMasterPassword -addItem :: Password -> String -> String -> Password -> Server Int +addItem :: Password -> String -> String -> Password -> Server ReturnCode addItem mp item username pass | length item + 1 > maxItemSize || length username + 1 > maxItemSize || - length pass + 1 > maxItemSize = return itemTooLong + length pass + 1 > maxItemSize = return ItemTooLong | otherwise = do w <- loadWallet case w of - Nothing -> return cannotLoadWallet - Just w -> - if masterPassword w == mp - -- FIXME check if item already exists - then saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) >> return retSuccess - else return wrongMasterPassword - -removeItem :: Password -> String -> Server Int -removeItem mp item = do + Nothing -> return CannotLoadWallet + Just w | not (masterPassword w == mp) -> return WrongMasterPassword + Just w | itemExists item username (items w) -> return ItemAlreadyExists + Just w -> saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) + +removeItem :: Password -> String -> String -> Server ReturnCode +removeItem mp title' username' = do w <- loadWallet case w of - Nothing -> return cannotLoadWallet - Just w | not (item `elem` (map title (items w))) -> return itemDoesNotExist - Just w | not (masterPassword w == mp) -> return wrongMasterPassword - Just w -> saveWallet (w { items = filter (not . (==) item . title) (items w), size = size w - 1}) >> return retSuccess + Nothing -> return CannotLoadWallet + Just w | not (itemExists title' username' (items w)) -> return ItemDoesNotExist + Just w | not (masterPassword w == mp) -> return WrongMasterPassword + Just w -> let newitems = removeItem' title' username' (items w) + in saveWallet (w { items = newitems, size = size w - 1}) + where + removeItem' :: String -> String -> [Item] -> [Item] + removeItem' title' uname items = + filter (\t -> title t /= title' && username t /= uname) items + +showItem :: Password -> String -> String -> Server (Either ReturnCode Password) +showItem mp title' username' = do + w <- loadWallet + case w of + Nothing -> return $ Left CannotLoadWallet + Just w | not (itemExists title' username' (items w)) -> return $ Left ItemDoesNotExist + Just w | not (masterPassword w == mp) -> return $ Left WrongMasterPassword + Just w -> return $ Right (findPass title' username' (items w)) + where + findPass :: String -> String -> [Item] -> Password + findPass title' username' items = + let singleton = filter (\t -> title t == title' && username t == username') items + in password (head singleton) + +itemExists :: String -> String -> [Item] -> Bool +itemExists title' uname items = + any (\t -> title t == title' && username t == uname) items -- * The application data Api = Api - { create :: Remote (Password -> Server Int) - , changePass :: Remote (Password -> Password -> Server Int) - , add :: Remote (Password -> String -> String -> Password -> Server Int) - , remove :: Remote (Password -> String -> Server Int) + { create :: Remote (Password -> Server ReturnCode) + , changePass :: Remote (Password -> Password -> Server ReturnCode) + , add :: Remote (Password -> String -> String -> Password -> Server ReturnCode) + , remove :: Remote (Password -> String -> String -> Server ReturnCode) + , showP :: Remote (Password -> String -> String -> Server (Either ReturnCode String)) } app :: App Done app = do -- The api - create <- remote $ createWallet - changePass <- remote $ changeMasterPassword - add <- remote $ addItem - remove <- remote $ removeItem + create <- ntimes 1 $ createWallet + changePass <- ntimes 1 $ changeMasterPassword + add <- ntimes 1 $ addItem + remove <- ntimes 1 $ removeItem + showP <- ntimes 1 $ showItem -- Client code - runClient $ clientApp $ Api create changePass add remove + runClient $ clientApp $ Api create changePass add remove showP data Command - = Create + = Create Password | Change Password Password - | Add String String Password - | Remove String + | Add Password String String Password + | Remove Password String String + | Show Password String String | Shutoff deriving Show @@ -157,50 +189,59 @@ clientApp :: Api -> Client () clientApp api = do cmd <- getCommand case cmd of - Shutoff -> liftIO (putStrLn "turning off...") >> return () - _ -> do liftIO $ hPutStr stdout "master password: " - liftIO $ hFlush stdout - mp <- liftIO $ getLine - r <- onServer $ case cmd of - Create -> create api <.> mp - Change old new -> changePass api <.> old <.> new - Add title username password -> add api <.> mp <.> title <.> username <.> password - Remove title -> remove api <.> mp <.> title - printCode r + Shutoff -> return () + Create mp -> do + r <- onServer $ create api <.> mp + printCode r + Change old new -> do + r <- onServer $ changePass api <.> old <.> new + printCode r + Add mp title username password -> do + r <- onServer $ add api <.> mp <.> title <.> username <.> password + printCode r + Remove mp title username -> do + r <- onServer $ remove api <.> mp <.> title <.> username + printCode r + Show mp title username -> do + p <- onServer $ showP api <.> mp <.> title <.> username + case p of + Left code -> printCode code + Right pass -> liftIO $ putStrLn pass getCommand :: Client Command getCommand = do - liftIO $ hPutStr stdout "> " - liftIO $ hFlush stdout - input <- liftIO $ getLine + input <- liftIO $ getContents case input of - [] -> getCommand + [] -> usage >> return Shutoff s -> case tryParse s of Just c -> return c - Nothing -> getCommand + Nothing -> usage >> return Shutoff where tryParse :: String -> Maybe Command tryParse input = case words input of - ["create"] -> Just Create - ["change", old, new] -> Just $ Change old new - ["add", title, username, password] -> Just $ Add title username password - ["remove", title] -> Just $ Remove title - ["shutoff"] -> Just Shutoff - otherwise -> Nothing - -printCode :: Int -> Client () -printCode c - | c == retSuccess = liftIO $ putStrLn $ "# ok" - | c == passwordOutOfRange = liftIO $ putStrLn $ "= password out of range" - | c == walletAlreadyExists = liftIO $ putStrLn $ "= wallet already exists" - | c == cannotSaveWallet = liftIO $ putStrLn $ "= cannot save wallet" - | c == cannotLoadWallet = liftIO $ putStrLn $ "= cannot load wallet" - | c == wrongMasterPassword = liftIO $ putStrLn $ "= wrong master password" - | c == walletFull = liftIO $ putStrLn $ "= wallet is full" - | c == itemDoesNotExist = liftIO $ putStrLn $ "= item does not exist" - | c == itemTooLong = liftIO $ putStrLn $ "= item is too long" - | c == failSeal = liftIO $ putStrLn $ "= failure while sealing wallet" - | c == failUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" + ["-n", mp] -> Just (Create mp) + ["-p", old, "-c", new] -> Just (Change old new) + [ "-p", mp, "-a", "-title", title, "-username", username, "-password", password] -> Just (Add mp title username password) + [ "-p", mp, "-r", "-title", title, "-username", username] -> Just (Remove mp title username) + [ "-p", mp, "-s", "-title", title, "-username", username] -> Just (Show mp title username) + otherwise -> Nothing + + usage :: Client () + usage = liftIO $ putStrLn "" + +printCode :: ReturnCode -> Client () +printCode Success = liftIO $ putStrLn $ "# ok" +printCode PasswordOutOfRange = liftIO $ putStrLn $ "= password out of range" +printCode WalletAlreadyExists = liftIO $ putStrLn $ "= wallet already exists" +printCode CannotSaveWallet = liftIO $ putStrLn $ "= cannot save wallet" +printCode CannotLoadWallet = liftIO $ putStrLn $ "= cannot load wallet" +printCode WrongMasterPassword = liftIO $ putStrLn $ "= wrong master password" +printCode WalletFull = liftIO $ putStrLn $ "= wallet is full" +printCode ItemDoesNotExist = liftIO $ putStrLn $ "= item does not exist" +printCode ItemAlreadyExists = liftIO $ putStrLn $ "= item already exists" +printCode ItemTooLong = liftIO $ putStrLn $ "= item is too long" +printCode FailSeal = liftIO $ putStrLn $ "= failure while sealing wallet" +printCode FailUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" main :: IO () main = do diff --git a/client.sh b/client.sh index fa0fccf..11dac1a 100755 --- a/client.sh +++ b/client.sh @@ -1 +1,4 @@ -cabal run EnclaveIFC-exe --project-file=cabal-nosgx.project +if [ $# -eq 0 ] + then cabal run EnclaveIFC-exe --project-file=cabal-nosgx.project + else echo "$@" | cabal run EnclaveIFC-exe --project-file=cabal-nosgx.project +fi diff --git a/src/Server.hs b/src/Server.hs index f5c1860..5439e5f 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -65,7 +65,6 @@ writeFile fp contents = Server (Prelude.writeFile fp contents) readFile :: String -> Server String readFile fp = Server (do handle <- openFile fp ReadMode contents <- hGetContents' handle - putStrLn $ show contents hClose handle return contents) where From 80207b329585b8147b3c96eddf768f84730fbfa0 Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Fri, 13 Jan 2023 16:19:38 +0100 Subject: [PATCH 03/12] Add CPP --- examples/SecureWallet/SecureWallet.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/examples/SecureWallet/SecureWallet.hs b/examples/SecureWallet/SecureWallet.hs index 7bae918..12e3663 100644 --- a/examples/SecureWallet/SecureWallet.hs +++ b/examples/SecureWallet/SecureWallet.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module SecureWallet where import App From 28f150da13890baf957145043979dcfd7e8018e4 Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Fri, 13 Jan 2023 16:34:52 +0100 Subject: [PATCH 04/12] patch --- app/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f76fd41..7145322 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -212,22 +212,22 @@ getCommand :: Client Command getCommand = do input <- liftIO $ getContents case input of - [] -> usage >> return Shutoff + [] -> usage "" >> return Shutoff s -> case tryParse s of Just c -> return c - Nothing -> usage >> return Shutoff + Nothing -> usage s >> return Shutoff where tryParse :: String -> Maybe Command tryParse input = case words input of - ["-n", mp] -> Just (Create mp) + ["-create", mp] -> Just (Create mp) ["-p", old, "-c", new] -> Just (Change old new) [ "-p", mp, "-a", "-title", title, "-username", username, "-password", password] -> Just (Add mp title username password) [ "-p", mp, "-r", "-title", title, "-username", username] -> Just (Remove mp title username) [ "-p", mp, "-s", "-title", title, "-username", username] -> Just (Show mp title username) otherwise -> Nothing - usage :: Client () - usage = liftIO $ putStrLn "" + usage :: String -> Client () + usage str = liftIO $ putStrLn $ "" ++ " : " ++ str printCode :: ReturnCode -> Client () printCode Success = liftIO $ putStrLn $ "# ok" From 0e6ca98c8a5e19c601a255bde648f55377db6e2a Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Fri, 13 Jan 2023 16:54:35 +0100 Subject: [PATCH 05/12] quick patch --- app/Main.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 7145322..a6cedb4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,6 @@ import System.IO import Text.Read import Data.Binary import GHC.Generics -import System.IO.Unsafe import App @@ -46,7 +45,7 @@ maxItemSize :: Int maxItemSize = 100 wallet :: String -wallet = "wallet.seal" +wallet = "/home/abhir00p/gramine/CI-Examples/hask-wallet/db/wallet.seal" -- * Data types @@ -77,10 +76,6 @@ passwordPolicy pass = length pass >= 8 && length pass + 1 <= maxItemSize loadWallet :: Server (Maybe Wallet) loadWallet = do b <- API.doesFileExist wallet - let x = unsafePerformIO (putStrLn (show b)) - if x == () - then return () - else return () if b then do contents <- API.readFile wallet return $ (readMaybe contents :: Maybe Wallet) From 7e492359980da3297605adbc50d1afbe1dac3126 Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Fri, 13 Jan 2023 17:03:29 +0100 Subject: [PATCH 06/12] Remove checks --- app/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a6cedb4..07d17c9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -87,11 +87,11 @@ saveWallet w = API.writeFile wallet (show w) >> return Success createWallet :: Password -> Server ReturnCode createWallet mp | not $ passwordPolicy mp = return PasswordOutOfRange - | otherwise = do - w <- loadWallet - case w of - Just _ -> return WalletAlreadyExists - Nothing -> saveWallet (newWallet mp) + | otherwise = saveWallet (newWallet mp)-- do + -- w <- loadWallet + -- case w of + -- Just _ -> return WalletAlreadyExists + -- Nothing -> saveWallet (newWallet mp) changeMasterPassword :: Password -> Password -> Server ReturnCode changeMasterPassword old new From 230ff40865ca0fb8f7c4819c45d230ec3bf8807e Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Sun, 15 Jan 2023 16:13:53 +0000 Subject: [PATCH 07/12] Fix the path to the sealed file --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 07d17c9..5e90bce 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -45,7 +45,7 @@ maxItemSize :: Int maxItemSize = 100 wallet :: String -wallet = "/home/abhir00p/gramine/CI-Examples/hask-wallet/db/wallet.seal" +wallet = "db/wallet.seal.pf" -- * Data types From cd72ae10a52ffbf2b10ca79c156e0ec90aac8423 Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Mon, 16 Jan 2023 16:04:47 +0000 Subject: [PATCH 08/12] Move back to wallet creation --- app/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 5e90bce..86a436e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -87,11 +87,11 @@ saveWallet w = API.writeFile wallet (show w) >> return Success createWallet :: Password -> Server ReturnCode createWallet mp | not $ passwordPolicy mp = return PasswordOutOfRange - | otherwise = saveWallet (newWallet mp)-- do - -- w <- loadWallet - -- case w of - -- Just _ -> return WalletAlreadyExists - -- Nothing -> saveWallet (newWallet mp) + | otherwise = do + w <- loadWallet + case w of + Just _ -> return WalletAlreadyExists + Nothing -> saveWallet (newWallet mp) changeMasterPassword :: Password -> Password -> Server ReturnCode changeMasterPassword old new From fcc86f0be77cb82da64c4dd072cb9dfe21ba3449 Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Tue, 21 Feb 2023 14:12:30 +0100 Subject: [PATCH 09/12] added the secure filepaths --- app/Denotation.hs | 27 +++++++ app/Main.hs | 189 +++++++++++++++++++++++++++++----------------- src/Client.hs | 20 +++++ src/Server.hs | 21 ++++++ 4 files changed, 189 insertions(+), 68 deletions(-) create mode 100644 app/Denotation.hs diff --git a/app/Denotation.hs b/app/Denotation.hs new file mode 100644 index 0000000..585149d --- /dev/null +++ b/app/Denotation.hs @@ -0,0 +1,27 @@ +module Denotation where + +import qualified Data.Map as Map + +type Var = String + +supply :: [Var] +supply = map ((++) "v" . show) [0..] + +fresh :: Int -> Var +fresh i = supply !! i + +type Store = (Map.Map Var Int, Map.Map Var Int) + +data Instruction + = ServerConstant Int + | Bind Instruction (Var -> Instruction) + +type StoreT = (Int,Store) -> (Int,Store,Var) + +eval :: Instruction -> StoreT +eval (ServerConstant x) = \(i, (tm, um)) -> + let v = fresh i + in (i+1, Map.insert v x tm, um, v) +eval (Bind ins f) = \(i, tm, um)) -> + let (i',(tm', um'),v) = eval ins (i, tm, um) + in eval (f (i, (tm', um'), v)) diff --git a/app/Main.hs b/app/Main.hs index 86a436e..34ee03f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,8 +4,9 @@ module Main where import Control.Monad.IO.Class(liftIO) import System.IO -import Text.Read +import Text.Read ( readMaybe ) import Data.Binary +import Data.Word import GHC.Generics @@ -32,7 +33,7 @@ data ReturnCode | ItemTooLong | FailSeal | FailUnseal - deriving Generic + deriving (Generic, Show) instance Binary ReturnCode @@ -44,22 +45,28 @@ maxItems = 100 maxItemSize :: Int maxItemSize = 100 -wallet :: String -wallet = "db/wallet.seal.pf" +wallet :: SecureFilePath +wallet = createSecurePath "wallet.seal.pf" -- * Data types +-- | A single entry of authentication tokens data Item = Item { title :: String + -- ^ Title of the online service, e.g Twitter, Youtune , username :: String , password :: String } deriving (Show, Read) +-- | The secure wallet data Wallet = Wallet { items :: [Item] + -- ^ All authentication tokens , size :: Int + -- ^ The size of the wallet , masterPassword :: String + -- ^ The master password that unlocks the wallet } deriving (Show, Read) @@ -75,23 +82,22 @@ passwordPolicy pass = length pass >= 8 && length pass + 1 <= maxItemSize loadWallet :: Server (Maybe Wallet) loadWallet = do - b <- API.doesFileExist wallet + b <- API.doesSecureFileExist wallet if b - then do contents <- API.readFile wallet + then do contents <- API.readSecureFile wallet return $ (readMaybe contents :: Maybe Wallet) else return Nothing saveWallet :: Wallet -> Server ReturnCode -saveWallet w = API.writeFile wallet (show w) >> return Success +saveWallet w = API.writeSecureFile wallet (show w) >> return Success +-- | Create a new password wallet createWallet :: Password -> Server ReturnCode -createWallet mp - | not $ passwordPolicy mp = return PasswordOutOfRange - | otherwise = do - w <- loadWallet - case w of - Just _ -> return WalletAlreadyExists - Nothing -> saveWallet (newWallet mp) +createWallet mp | not $ passwordPolicy mp = return PasswordOutOfRange + | otherwise = do w <- loadWallet -- does a wallet already exist? + case w of + Just _ -> return WalletAlreadyExists + Nothing -> saveWallet (newWallet mp) changeMasterPassword :: Password -> Password -> Server ReturnCode changeMasterPassword old new @@ -117,6 +123,16 @@ addItem mp item username pass Just w | itemExists item username (items w) -> return ItemAlreadyExists Just w -> saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) +{-@ +addItem :: Password -> String -> String -> Password -> Server ReturnCode +addItem mp item username pass = do + w <- loadWallet + case w of + Nothing -> return CannotLoadWallet + Just w | not (masterPassword w == mp) -> return WrongMasterPassword + Just w -> saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) +@-} + removeItem :: Password -> String -> String -> Server ReturnCode removeItem mp title' username' = do w <- loadWallet @@ -145,72 +161,125 @@ showItem mp title' username' = do let singleton = filter (\t -> title t == title' && username t == username') items in password (head singleton) +{-@ +-- | Return a password from the password wallet, given the title and username +showItem :: Password -> String -> String -> Server (Either ReturnCode Password) +showItem mp title' username' = do + w <- loadWallet + case w of + Nothing -> return $ Left CannotLoadWallet + -- If the supplied master password is wrong, abort + Just w | not (masterPassword w == mp) -> return $ Left WrongMasterPassword + -- otherwise we look up the password and return it to the client + Just w -> return $ Right (findPass title' username' (items w)) +@-} + itemExists :: String -> String -> [Item] -> Bool itemExists title' uname items = any (\t -> title t == title' && username t == uname) items +handleCommand :: Command -> Server (Either ReturnCode String) +handleCommand cmd = case cmd of + Create s -> fmap Left $ createWallet s + Change s str -> fmap Left $ changeMasterPassword s str + Add s str cs s' -> fmap Left $ addItem s str cs s' + Remove s str cs -> fmap Left $ removeItem s str cs + Show s str cs -> showItem s str cs + Shutoff -> return $ Left Success + -- * The application -data Api = Api - { create :: Remote (Password -> Server ReturnCode) - , changePass :: Remote (Password -> Password -> Server ReturnCode) - , add :: Remote (Password -> String -> String -> Password -> Server ReturnCode) - , remove :: Remote (Password -> String -> String -> Server ReturnCode) - , showP :: Remote (Password -> String -> String -> Server (Either ReturnCode String)) - } +data Api = Api { execute :: Remote (Command -> Server (Either ReturnCode String)) } +{-@ +-- | Commands exposed by the password wallet +data Command + = Create Password + -- ^ Create a new wallet with the given master password + | Add Password String String Password + -- ^ Add an item to the password wallet + | Show Password String String + -- ^ Retrieve a password from the password wallet + -- more commands, omitted for brevity + deriving (Show, Binary) + +-- | Execute a command in the enclave +handleCommand :: Command -> Server (Either ReturnCode String) +handleCommand cmd = case cmd of + Create s -> fmap Left $ createWallet s + Add s str cs s' -> fmap Left $ addItem s str cs s' + Show s str cs -> showItem s str cs + -- more commands, omitted for brevity + +-- | Main application with the configuration code and client logic app :: App Done app = do - -- The api - create <- ntimes 1 $ createWallet - changePass <- ntimes 1 $ changeMasterPassword - add <- ntimes 1 $ addItem - remove <- ntimes 1 $ removeItem - showP <- ntimes 1 $ showItem + -- make handleCommand callable on the client + execute <- remote handleCommand + runClient $ do + cmd <- getCommand -- parse input arguments + r <- onEnclave $ execute <.> cmd + case r of + Left code -> liftIO $ putStrLn $ show code + Right p -> liftIO $ putStrLn $ concat ["retrieved pass: ", show p] +@-} - -- Client code - runClient $ clientApp $ Api create changePass add remove showP +app :: App Done +app = do + execute <- remote handleCommand + runClient $ clientApp $ Api execute +-- | Commands exposed by the password wallet data Command = Create Password + -- ^ Create a new wallet with the given master password | Change Password Password + -- ^ Change the master password | Add Password String String Password + -- ^ Add an item to the password wallet | Remove Password String String + -- ^ Remove an item from the password wallet | Show Password String String + -- ^ Retrieve a password from the password wallet | Shutoff + -- ^ No-op deriving Show +instance Binary Command where + put (Create pw) = put (1 :: Word8) >> put pw + put (Change pw npw) = put (2 :: Word8) >> put pw >> put npw + put (Add pw title uname pass) = put (3 :: Word8) >> put pw >> put title >> put uname >> put pass + put (Remove pw title uname) = put (4 :: Word8) >> put pw >> put title >> put uname + put (Show pw title uname) = put (5 :: Word8) >> put pw >> put title >> put uname + put Shutoff = put (6 :: Word8) + + get = do + c <- get :: Get Word8 + case c of + 1 -> Create <$> get + 2 -> Change <$> get <*> get + 3 -> Add <$> get <*> get <*> get <*> get + 4 -> Remove <$> get <*> get <*> get + 5 -> Show <$> get <*> get <*> get + 6 -> return Shutoff + _ -> error "unrecognized command" + clientApp :: Api -> Client () clientApp api = do cmd <- getCommand - case cmd of - Shutoff -> return () - Create mp -> do - r <- onServer $ create api <.> mp - printCode r - Change old new -> do - r <- onServer $ changePass api <.> old <.> new - printCode r - Add mp title username password -> do - r <- onServer $ add api <.> mp <.> title <.> username <.> password - printCode r - Remove mp title username -> do - r <- onServer $ remove api <.> mp <.> title <.> username - printCode r - Show mp title username -> do - p <- onServer $ showP api <.> mp <.> title <.> username - case p of - Left code -> printCode code - Right pass -> liftIO $ putStrLn pass + codeOrPass <- onServer $ execute api <.> cmd + case codeOrPass of + Left code -> liftIO $ putStrLn $ show code + Right pass -> liftIO $ putStrLn pass getCommand :: Client Command getCommand = do input <- liftIO $ getContents case input of - [] -> usage "" >> return Shutoff + [] -> return Shutoff s -> case tryParse s of Just c -> return c - Nothing -> usage s >> return Shutoff + Nothing -> return Shutoff where tryParse :: String -> Maybe Command tryParse input = case words input of @@ -219,24 +288,8 @@ getCommand = do [ "-p", mp, "-a", "-title", title, "-username", username, "-password", password] -> Just (Add mp title username password) [ "-p", mp, "-r", "-title", title, "-username", username] -> Just (Remove mp title username) [ "-p", mp, "-s", "-title", title, "-username", username] -> Just (Show mp title username) - otherwise -> Nothing - - usage :: String -> Client () - usage str = liftIO $ putStrLn $ "" ++ " : " ++ str - -printCode :: ReturnCode -> Client () -printCode Success = liftIO $ putStrLn $ "# ok" -printCode PasswordOutOfRange = liftIO $ putStrLn $ "= password out of range" -printCode WalletAlreadyExists = liftIO $ putStrLn $ "= wallet already exists" -printCode CannotSaveWallet = liftIO $ putStrLn $ "= cannot save wallet" -printCode CannotLoadWallet = liftIO $ putStrLn $ "= cannot load wallet" -printCode WrongMasterPassword = liftIO $ putStrLn $ "= wrong master password" -printCode WalletFull = liftIO $ putStrLn $ "= wallet is full" -printCode ItemDoesNotExist = liftIO $ putStrLn $ "= item does not exist" -printCode ItemAlreadyExists = liftIO $ putStrLn $ "= item already exists" -printCode ItemTooLong = liftIO $ putStrLn $ "= item is too long" -printCode FailSeal = liftIO $ putStrLn $ "= failure while sealing wallet" -printCode FailUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" + [ "-shutoff"] -> Just Shutoff + _ -> Nothing main :: IO () main = do diff --git a/src/Client.hs b/src/Client.hs index 834dc1f..9256019 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -70,6 +70,26 @@ doesFileExist _ = ServerDummy unsafePrint :: String -> Server () unsafePrint _ = ServerDummy +-- + +securePath :: String +securePath = "" + +data SecureFilePath = SecureFilePath String + +createSecurePath :: FilePath -> SecureFilePath +createSecurePath fp = SecureFilePath $ securePath <> fp + +readSecureFile :: SecureFilePath -> Server String +readSecureFile (SecureFilePath fp) = Client.readFile fp + +writeSecureFile :: SecureFilePath -> String -> Server () +writeSecureFile (SecureFilePath fp) str = Client.writeFile fp str + +doesSecureFileExist :: SecureFilePath -> Server Bool +doesSecureFileExist (SecureFilePath fp) = Client.doesFileExist fp +-- + type Client = IO diff --git a/src/Server.hs b/src/Server.hs index 5439e5f..55a8c77 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -86,6 +86,27 @@ doesFileExist fp = Server $ unsafePrint :: String -> Server () unsafePrint str = Server $ putStrLn str +-- * Secure file io + +securePath :: String +securePath = "db/" + +data SecureFilePath = SecureFilePath String + +createSecurePath :: FilePath -> SecureFilePath +createSecurePath fp = SecureFilePath $ securePath <> fp + +readSecureFile :: SecureFilePath -> Server String +readSecureFile (SecureFilePath fp) = Server.readFile fp + +writeSecureFile :: SecureFilePath -> String -> Server () +writeSecureFile (SecureFilePath fp) str = Server.writeFile fp str + +doesSecureFileExist :: SecureFilePath -> Server Bool +doesSecureFileExist (SecureFilePath fp) = Server.doesFileExist fp + +-- + -- * Other stuff remote :: (Remotable a) => a -> App (Remote a) From f6e04560e39f099821197d606eaefdf6701c4857 Mon Sep 17 00:00:00 2001 From: Robert Krook Date: Wed, 1 Mar 2023 19:40:52 +0100 Subject: [PATCH 10/12] tidy up --- app/Main.hs | 74 +++-------------------------------------------------- 1 file changed, 3 insertions(+), 71 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 34ee03f..cd72b72 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,10 +3,8 @@ module Main where import Control.Monad.IO.Class(liftIO) -import System.IO import Text.Read ( readMaybe ) import Data.Binary -import Data.Word import GHC.Generics @@ -21,19 +19,9 @@ import Client as API -- * Return codes data ReturnCode - = Success - | PasswordOutOfRange - | WalletAlreadyExists - | CannotSaveWallet - | CannotLoadWallet - | WrongMasterPassword - | WalletFull - | ItemDoesNotExist - | ItemAlreadyExists - | ItemTooLong - | FailSeal - | FailUnseal - deriving (Generic, Show) + = Success | PasswordOutOfRange | WalletAlreadyExists | CannotSaveWallet | CannotLoadWallet + | WrongMasterPassword | WalletFull | ItemDoesNotExist | ItemAlreadyExists | ItemTooLong + | FailSeal | FailUnseal deriving (Generic, Show) instance Binary ReturnCode @@ -123,16 +111,6 @@ addItem mp item username pass Just w | itemExists item username (items w) -> return ItemAlreadyExists Just w -> saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) -{-@ -addItem :: Password -> String -> String -> Password -> Server ReturnCode -addItem mp item username pass = do - w <- loadWallet - case w of - Nothing -> return CannotLoadWallet - Just w | not (masterPassword w == mp) -> return WrongMasterPassword - Just w -> saveWallet (w { items = (Item item username pass) : items w, size = size w + 1}) -@-} - removeItem :: Password -> String -> String -> Server ReturnCode removeItem mp title' username' = do w <- loadWallet @@ -161,19 +139,6 @@ showItem mp title' username' = do let singleton = filter (\t -> title t == title' && username t == username') items in password (head singleton) -{-@ --- | Return a password from the password wallet, given the title and username -showItem :: Password -> String -> String -> Server (Either ReturnCode Password) -showItem mp title' username' = do - w <- loadWallet - case w of - Nothing -> return $ Left CannotLoadWallet - -- If the supplied master password is wrong, abort - Just w | not (masterPassword w == mp) -> return $ Left WrongMasterPassword - -- otherwise we look up the password and return it to the client - Just w -> return $ Right (findPass title' username' (items w)) -@-} - itemExists :: String -> String -> [Item] -> Bool itemExists title' uname items = any (\t -> title t == title' && username t == uname) items @@ -191,39 +156,6 @@ handleCommand cmd = case cmd of data Api = Api { execute :: Remote (Command -> Server (Either ReturnCode String)) } -{-@ --- | Commands exposed by the password wallet -data Command - = Create Password - -- ^ Create a new wallet with the given master password - | Add Password String String Password - -- ^ Add an item to the password wallet - | Show Password String String - -- ^ Retrieve a password from the password wallet - -- more commands, omitted for brevity - deriving (Show, Binary) - --- | Execute a command in the enclave -handleCommand :: Command -> Server (Either ReturnCode String) -handleCommand cmd = case cmd of - Create s -> fmap Left $ createWallet s - Add s str cs s' -> fmap Left $ addItem s str cs s' - Show s str cs -> showItem s str cs - -- more commands, omitted for brevity - --- | Main application with the configuration code and client logic -app :: App Done -app = do - -- make handleCommand callable on the client - execute <- remote handleCommand - runClient $ do - cmd <- getCommand -- parse input arguments - r <- onEnclave $ execute <.> cmd - case r of - Left code -> liftIO $ putStrLn $ show code - Right p -> liftIO $ putStrLn $ concat ["retrieved pass: ", show p] -@-} - app :: App Done app = do execute <- remote handleCommand From b8654ae7499d820750028c4787cadc00c46f232a Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Thu, 7 Sep 2023 15:49:02 -0700 Subject: [PATCH 11/12] Timing operations --- EnclaveIFC.cabal | 4 +++ app/Main.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++-- benchmarks.md | 60 +++++++++++++++++++++++++++++++++++++ db/gpg | 0 db/secretfile.gpg | 2 ++ db/wallet.gpg | 1 + db/wallet.seal.pf | 1 + db/wallet.seal.pf1 | 1 + 8 files changed, 142 insertions(+), 2 deletions(-) create mode 100644 benchmarks.md create mode 100644 db/gpg create mode 100644 db/secretfile.gpg create mode 100644 db/wallet.gpg create mode 100644 db/wallet.seal.pf create mode 100644 db/wallet.seal.pf1 diff --git a/EnclaveIFC.cabal b/EnclaveIFC.cabal index 8475685..2c9c90e 100644 --- a/EnclaveIFC.cabal +++ b/EnclaveIFC.cabal @@ -65,6 +65,8 @@ executable EnclaveIFC-exe , bytestring , network-simple , transformers + , time + , process if (flag(enclave)) cpp-options: -DENCLAVE else @@ -82,6 +84,8 @@ executable SecureWallet-exe , bytestring , network-simple , transformers + , time + , process if (flag(enclave)) cpp-options: -DENCLAVE else diff --git a/app/Main.hs b/app/Main.hs index cd72b72..9190026 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,11 @@ import Control.Monad.IO.Class(liftIO) import Text.Read ( readMaybe ) import Data.Binary import GHC.Generics +import Data.Time.Clock +import System.IO +import Control.Exception +import System.Process import App @@ -76,6 +80,36 @@ loadWallet = do return $ (readMaybe contents :: Maybe Wallet) else return Nothing + +dFx :: IO Bool +dFx = (openFile fp ReadMode >>= hClose >> return True) `catch` \ex -> let e = ex :: SomeException + in return False + where fp = "db/wallet.seal.pf" + +rF :: String -> IO String +rF fp = (do handle <- openFile fp ReadMode + contents <- hGetContents' handle + hClose handle + return contents) + where + hGetContents' :: Handle -> IO String + hGetContents' h = do + eof <- hIsEOF h + if eof + then + return [] + else do + c <- hGetChar h + fmap (c:) $ hGetContents' h + +loadWallet' :: IO (Maybe Wallet) +loadWallet' = do + b <- dFx + if b + then do contents <- rF "db/wallet.seal.pf" + return (readMaybe contents :: Maybe Wallet) + else return Nothing + saveWallet :: Wallet -> Server ReturnCode saveWallet w = API.writeSecureFile wallet (show w) >> return Success @@ -139,6 +173,20 @@ showItem mp title' username' = do let singleton = filter (\t -> title t == title' && username t == username') items in password (head singleton) +sI :: Password -> String -> String -> IO (Either ReturnCode Password) +sI mp title' username' = do + w <- loadWallet' + case w of + Nothing -> return $ Left CannotLoadWallet + Just w | not (itemExists title' username' (items w)) -> return $ Left ItemDoesNotExist + Just w | not (masterPassword w == mp) -> return $ Left WrongMasterPassword + Just w -> return $ Right (findPass title' username' (items w)) + where + findPass :: String -> String -> [Item] -> Password + findPass title' username' items = + let singleton = filter (\t -> title t == title' && username t == username') items + in password (head singleton) + itemExists :: String -> String -> [Item] -> Bool itemExists title' uname items = any (\t -> title t == title' && username t == uname) items @@ -152,6 +200,15 @@ handleCommand cmd = case cmd of Show s str cs -> showItem s str cs Shutoff -> return $ Left Success +hC :: Command -> IO (Either ReturnCode String) +hC cmd = case cmd of + Create s -> fmap Left $ return PasswordOutOfRange + Change s str -> fmap Left $ return PasswordOutOfRange + Add s str cs s' -> fmap Left $ return ItemTooLong + Remove s str cs -> fmap Left $ return CannotLoadWallet + Show s str cs -> sI s str cs + Shutoff -> return $ Left Success + -- * The application data Api = Api { execute :: Remote (Command -> Server (Either ReturnCode String)) } @@ -199,10 +256,15 @@ instance Binary Command where clientApp :: Api -> Client () clientApp api = do cmd <- getCommand - codeOrPass <- onServer $ execute api <.> cmd + runCommand shell -- decrypt + --codeOrPass <- onServer $ execute api <.> cmd + codeOrPass <- hC cmd + --let codeOrPass = Right "strongpassword" :: Either ReturnCode Password case codeOrPass of Left code -> liftIO $ putStrLn $ show code Right pass -> liftIO $ putStrLn pass + where + shell = "gpg --batch --output db/wallet.seal.pf --passphrase mypassword --decrypt db/wallet.gpg" getCommand :: Client Command getCommand = do @@ -223,7 +285,16 @@ getCommand = do [ "-shutoff"] -> Just Shutoff _ -> Nothing + +timeit :: IO Done -> IO NominalDiffTime +timeit doit=do + start <- getCurrentTime + doit + end <- getCurrentTime + return (diffUTCTime end start) + main :: IO () main = do - res <- runApp app + res <- timeit $ runApp app + putStrLn $ "Time : " ++ show res return $ res `seq` () diff --git a/benchmarks.md b/benchmarks.md new file mode 100644 index 0000000..08aa672 --- /dev/null +++ b/benchmarks.md @@ -0,0 +1,60 @@ +#### Response Time for password retrieval (involves file read as well) + +Time is measure in seconds + +Note the non-SGX Haskell file is unencrypted + +Average numbers for non-SGX Haskell + encryption ~ 0.0006-0.0008; encryption (gpg) adds 0.0002 + +HasTEE + SGX | Haskell (no SGX) | C (with SGX) +------------------------------------------------ +0.069940556 | 0.000294702 | +0.068725749 | 0.000281502 | +0.067006642 | 0.000269602 | +0.066853754 | 0.000269502 | +0.065263212 | 0.000263302 | +0.067077723 | 0.000273002 | +0.065565735 | 0.000270201 | +0.066263339 | 0.000267401 | +0.069965863 | 0.000278902 | +0.067200845 | 0.000266402 | +0.066725642 | 0.000261902 | +0.066660041 | 0.000669205 | +0.064793828 | 0.000265201 | +0.067570645 | 0.000270102 | +0.066741938 | 0.000346202 | +0.066609036 | 0.000265802 | +0.069043651 | 0.000265202 | +0.064523418 | 0.000271402 | +0.068659852 | 0.000312402 | +0.068592748 | 0.000316202 | +0.065454141 | 0.000267502 | +0.068226754 | 0.000277202 | +0.068951357 | 0.000265802 | + + +##### Memory usage + +ps aux | grep gramine +syrupy.py -p <> + +pidstat -h -r -u -v -p 2070798 1 +sample every 1 second for pid 2070798 + +pmap <> | tail -n 1 +287920 KB - 287.92 MB +287924 KB - 287.92 MB + +ps +-- +RSS - RSS is Resident Set Size. This is the size of memory that a process has currently used to load all of its pages. At first glance, it may seem like the RSS number is the real amount of physical memory that a system process is using. However, shared libraries are counted for each process, making the reported amount of physical memory usage less accurate. + +Vsize - VSZ is Virtual Memory Size. This is the size of memory that Linux has given to a process, but it doesn’t necessarily mean that the process is using all of that memory. The VSZ size you see has taken all of these pages into consideration, but it doesn’t mean they’ve been loaded into physical memory. + +Wallet app +---------- + RSS Vsize +at rest 19132KB 287920KB +peak 20796KB 290032KB + +No disk swapping \ No newline at end of file diff --git a/db/gpg b/db/gpg new file mode 100644 index 0000000..e69de29 diff --git a/db/secretfile.gpg b/db/secretfile.gpg new file mode 100644 index 0000000..9799d38 --- /dev/null +++ b/db/secretfile.gpg @@ -0,0 +1,2 @@ +  uSB'HUQsuokEx~ +J!NVp!|=,,+ \ No newline at end of file diff --git a/db/wallet.gpg b/db/wallet.gpg new file mode 100644 index 0000000..69b6cfe --- /dev/null +++ b/db/wallet.gpg @@ -0,0 +1 @@ +  iyHG.ҫ&,inDY_2vVP{Uڍc@%/)iے!Ac>5F k%lqt-^VXg{O ڵC6<=p/Xy!fJSr;=yD &;l̍7C_.`6so \ No newline at end of file diff --git a/db/wallet.seal.pf b/db/wallet.seal.pf new file mode 100644 index 0000000..2c8089b --- /dev/null +++ b/db/wallet.seal.pf @@ -0,0 +1 @@ +Wallet {items = [Item {title = "youtube", username = "rewbert", password = "strongpassword"}], size = 1, masterPassword = "abhiroop"} \ No newline at end of file diff --git a/db/wallet.seal.pf1 b/db/wallet.seal.pf1 new file mode 100644 index 0000000..2c8089b --- /dev/null +++ b/db/wallet.seal.pf1 @@ -0,0 +1 @@ +Wallet {items = [Item {title = "youtube", username = "rewbert", password = "strongpassword"}], size = 1, masterPassword = "abhiroop"} \ No newline at end of file From 0ae4f9409ef0c7fa0bb4178a0bebb2706aa758e6 Mon Sep 17 00:00:00 2001 From: Abhiroop Date: Mon, 16 Oct 2023 09:38:11 +0000 Subject: [PATCH 12/12] Push diffs to securewallet --- HasNoSGX.diff | 142 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 HasNoSGX.diff diff --git a/HasNoSGX.diff b/HasNoSGX.diff new file mode 100644 index 0000000..885781d --- /dev/null +++ b/HasNoSGX.diff @@ -0,0 +1,142 @@ +diff --git a/app/Main.hs b/app/Main.hs +index 86a436e..b293fe6 100644 +--- a/app/Main.hs ++++ b/app/Main.hs +@@ -7,10 +7,14 @@ import System.IO + import Text.Read + import Data.Binary + import GHC.Generics +- ++import Data.Time.Clock + + import App + ++import System.IO ++import Control.Exception ++ ++ + #ifdef ENCLAVE + import Server as API + #else +@@ -32,7 +36,7 @@ data ReturnCode + | ItemTooLong + | FailSeal + | FailUnseal +- deriving Generic ++ deriving (Generic, Show) + + instance Binary ReturnCode + +@@ -81,6 +85,35 @@ loadWallet = do + return $ (readMaybe contents :: Maybe Wallet) + else return Nothing + ++dFx :: IO Bool ++dFx = (openFile fp ReadMode >>= hClose >> return True) `catch` \ex -> let e = ex :: SomeException ++ in return False ++ where fp = "db/wallet.seal.pf" ++ ++rF :: String -> IO String ++rF fp = (do handle <- openFile fp ReadMode ++ contents <- hGetContents' handle ++ hClose handle ++ return contents) ++ where ++ hGetContents' :: Handle -> IO String ++ hGetContents' h = do ++ eof <- hIsEOF h ++ if eof ++ then ++ return [] ++ else do ++ c <- hGetChar h ++ fmap (c:) $ hGetContents' h ++ ++loadWallet' :: IO (Maybe Wallet) ++loadWallet' = do ++ b <- dFx ++ if b ++ then do contents <- rF "db/wallet.seal.pf" ++ return (readMaybe contents :: Maybe Wallet) ++ else return Nothing ++ + saveWallet :: Wallet -> Server ReturnCode + saveWallet w = API.writeFile wallet (show w) >> return Success + +@@ -145,6 +178,20 @@ showItem mp title' username' = do + let singleton = filter (\t -> title t == title' && username t == username') items + in password (head singleton) + ++sI :: Password -> String -> String -> IO (Either ReturnCode Password) ++sI mp title' username' = do ++ w <- loadWallet' ++ case w of ++ Nothing -> return $ Left CannotLoadWallet ++ Just w | not (itemExists title' username' (items w)) -> return $ Left ItemDoesNotExist ++ Just w | not (masterPassword w == mp) -> return $ Left WrongMasterPassword ++ Just w -> return $ Right (findPass title' username' (items w)) ++ where ++ findPass :: String -> String -> [Item] -> Password ++ findPass title' username' items = ++ let singleton = filter (\t -> title t == title' && username t == username') items ++ in password (head singleton) ++ + itemExists :: String -> String -> [Item] -> Bool + itemExists title' uname items = + any (\t -> title t == title' && username t == uname) items +@@ -183,6 +230,12 @@ data Command + clientApp :: Api -> Client () + clientApp api = do + cmd <- getCommand ++ codeOrPass <- hC cmd ++ case codeOrPass of ++ Left code -> liftIO $ putStrLn $ show code ++ Right pass -> liftIO $ putStrLn pass ++ ++ {- + case cmd of + Shutoff -> return () + Create mp -> do +@@ -202,6 +255,7 @@ clientApp api = do + case p of + Left code -> printCode code + Right pass -> liftIO $ putStrLn pass ++ -} + + getCommand :: Client Command + getCommand = do +@@ -224,6 +278,15 @@ getCommand = do + usage :: String -> Client () + usage str = liftIO $ putStrLn $ "" ++ " : " ++ str + ++hC :: Command -> IO (Either ReturnCode String) ++hC cmd = case cmd of ++ Create s -> fmap Left $ return PasswordOutOfRange ++ Change s str -> fmap Left $ return PasswordOutOfRange ++ Add s str cs s' -> fmap Left $ return ItemTooLong ++ Remove s str cs -> fmap Left $ return CannotLoadWallet ++ Show s str cs -> sI s str cs ++ Shutoff -> return $ Left Success ++ + printCode :: ReturnCode -> Client () + printCode Success = liftIO $ putStrLn $ "# ok" + printCode PasswordOutOfRange = liftIO $ putStrLn $ "= password out of range" +@@ -238,7 +301,17 @@ printCode ItemTooLong = liftIO $ putStrLn $ "= item is too long" + printCode FailSeal = liftIO $ putStrLn $ "= failure while sealing wallet" + printCode FailUnseal = liftIO $ putStrLn $ "= failure while unsealing wallet" + ++ ++ ++timeit::IO Done -> IO NominalDiffTime ++timeit doit=do ++ start <- getCurrentTime ++ doit ++ end <- getCurrentTime ++ return (diffUTCTime end start) ++ + main :: IO () + main = do +- res <- runApp app ++ res <- timeit $ runApp app ++ putStrLn $ "Time : " ++ show res + return $ res `seq` ()