-- This file is part of Diohsc -- Copyright (C) 2020 Martin Bays -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of version 3 of the GNU General Public License as -- published by the Free Software Foundation, or any later version. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. {-# LANGUAGE LambdaCase #-} module ServiceCerts where import Data.List (elemIndex) import Data.PEM import Data.X509 import Data.X509.Validation import System.Directory (doesFileExist, renamePath) import System.FilePath import qualified Data.ByteString as BS import qualified Data.Text as TS import qualified Data.Text.Encoding as TS import Mundanities import Util serviceToString :: ServiceID -> String serviceToString (host, suffix) = host ++ TS.unpack (TS.decodeUtf8 suffix) -- |service suffix must start with ':' stringToService :: String -> ServiceID stringToService s = maybe (s, BS.empty) (\i -> (take i s, TS.encodeUtf8 . TS.pack . drop i $ s)) (elemIndex ':' s) loadServiceCert :: FilePath -> ServiceID -> IO (Maybe SignedCertificate) loadServiceCert path service = let filepath = path serviceToString service in ignoreIOErrAlt $ (\case Right [PEM _ _ content] -> case decodeSignedCertificate content of Right cert -> Just cert _ -> Nothing _ -> Nothing) . pemParseBS <$> BS.readFile filepath saveServiceCert :: FilePath -> ServiceID -> SignedCertificate -> IO () saveServiceCert path service cert = let filepath = path serviceToString service in isSubPath path filepath >>? do doesFileExist filepath >>? renamePath filepath (filepath ++ ".bk") BS.writeFile filepath . pemWriteBS . PEM "CERTIFICATE" [] . encodeSignedObject $ cert