1 -- This file is part of Diohsc
2 -- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
4 -- This program is free software: you can redistribute it and/or modify
5 -- it under the terms of version 3 of the GNU General Public License as
6 -- published by the Free Software Foundation, or any later version.
8 -- You should have received a copy of the GNU General Public License
9 -- along with this program. If not, see http://www.gnu.org/licenses/.
11 {-# LANGUAGE LambdaCase #-}
13 module ServiceCerts
where
15 import Data
.List
(elemIndex)
18 import Data
.X509
.Validation
19 import System
.FilePath
21 import qualified Data
.ByteString
as BS
22 import qualified Data
.Text
as TS
23 import qualified Data
.Text
.Encoding
as TS
28 serviceToString
:: ServiceID
-> String
29 serviceToString
(host
, suffix
) = host
++ TS
.unpack
(TS
.decodeUtf8 suffix
)
31 -- |service suffix must start with ':'
32 stringToService
:: String -> ServiceID
33 stringToService s
= maybe
35 (\i
-> (take i s
, TS
.encodeUtf8
. TS
.pack
. drop i
$ s
))
38 loadServiceCert
:: FilePath -> ServiceID
-> IO (Maybe SignedCertificate
)
39 loadServiceCert path service
=
40 let filepath
= path
</> serviceToString service
41 in ignoreIOErrAlt
$ (\case
42 Right
[PEM _ _ content
] -> case decodeSignedCertificate content
of
43 Right cert
-> Just cert
45 _
-> Nothing
) . pemParseBS
<$> BS
.readFile filepath
47 saveServiceCert
:: FilePath -> ServiceID
-> SignedCertificate
-> IO ()
48 saveServiceCert path service cert
=
49 let filepath
= path
</> serviceToString service
50 in isSubPath path filepath
>>? BS
.writeFile filepath
.
51 pemWriteBS
. PEM
"CERTIFICATE" [] . encodeSignedObject
$ cert