module Codec.Encryption.OpenPGP.Expirations
( isTKTimeValid
, getKeyExpirationTimesFromSignature
) where
import Control.Lens ((&), (^.), _1)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Codec.Encryption.OpenPGP.Ontology (isKET)
import Codec.Encryption.OpenPGP.Types
isTKTimeValid :: UTCTime -> TK -> Bool
isTKTimeValid :: UTCTime -> TK -> Bool
isTKTimeValid ct :: UTCTime
ct key :: TK
key = UTCTime
ct UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
keyCreationTime Bool -> Bool -> Bool
&& UTCTime
ct UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
keyExpirationTime
where
keyCreationTime :: UTCTime
keyCreationTime =
TK
key TK
-> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
-> ThirtyTwoBitTimeStamp
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> TK -> Const ThirtyTwoBitTimeStamp TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> TK -> Const ThirtyTwoBitTimeStamp TK)
-> ((ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> ((ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload
Lens' PKPayload ThirtyTwoBitTimeStamp
timestamp ThirtyTwoBitTimeStamp
-> (ThirtyTwoBitTimeStamp -> UTCTime) -> UTCTime
forall a b. a -> (a -> b) -> b
& POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (ThirtyTwoBitTimeStamp -> POSIXTime)
-> ThirtyTwoBitTimeStamp
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
keyExpirationTime :: UTCTime
keyExpirationTime =
POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> ([SignaturePayload] -> POSIXTime)
-> [SignaturePayload]
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Word32 -> POSIXTime)
-> ([SignaturePayload] -> Word32)
-> [SignaturePayload]
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((TK
key TK
-> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
-> ThirtyTwoBitTimeStamp
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> TK -> Const ThirtyTwoBitTimeStamp TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> TK -> Const ThirtyTwoBitTimeStamp TK)
-> ((ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> Getting ThirtyTwoBitTimeStamp TK ThirtyTwoBitTimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum))
-> ((ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload)
-> (ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> (PKPayload, Maybe SKAddendum)
-> Const ThirtyTwoBitTimeStamp (PKPayload, Maybe SKAddendum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThirtyTwoBitTimeStamp
-> Const ThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp)
-> PKPayload -> Const ThirtyTwoBitTimeStamp PKPayload
Lens' PKPayload ThirtyTwoBitTimeStamp
timestamp ThirtyTwoBitTimeStamp
-> (ThirtyTwoBitTimeStamp -> Word32) -> Word32
forall a b. a -> (a -> b) -> b
& ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+) (Word32 -> Word32)
-> ([SignaturePayload] -> Word32) -> [SignaturePayload] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ThirtyTwoBitDuration -> Word32
unThirtyTwoBitDuration (ThirtyTwoBitDuration -> Word32)
-> ([SignaturePayload] -> ThirtyTwoBitDuration)
-> [SignaturePayload]
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[ThirtyTwoBitDuration] -> ThirtyTwoBitDuration
forall p. (Bounded p, Ord p) => [p] -> p
newest ([ThirtyTwoBitDuration] -> ThirtyTwoBitDuration)
-> ([SignaturePayload] -> [ThirtyTwoBitDuration])
-> [SignaturePayload]
-> ThirtyTwoBitDuration
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(SignaturePayload -> [ThirtyTwoBitDuration])
-> [SignaturePayload] -> [ThirtyTwoBitDuration]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature ([SignaturePayload] -> UTCTime) -> [SignaturePayload] -> UTCTime
forall a b. (a -> b) -> a -> b
$
(((Text, [SignaturePayload]) -> [SignaturePayload])
-> [(Text, [SignaturePayload])] -> [SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd (TK
key TK
-> Getting
[(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
[(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
Lens' TK [(Text, [SignaturePayload])]
tkUIDs) [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ (([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd (TK
key TK
-> Getting
[([UserAttrSubPacket], [SignaturePayload])]
TK
[([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
[([UserAttrSubPacket], [SignaturePayload])]
TK
[([UserAttrSubPacket], [SignaturePayload])]
Lens' TK [([UserAttrSubPacket], [SignaturePayload])]
tkUAts))
newest :: [p] -> p
newest [] = p
forall a. Bounded a => a
maxBound
newest xs :: [p]
xs = [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [p]
xs
getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature (SigV4 _ _ _ xs :: [SigSubPacket]
xs _ _ _) =
(SigSubPacket -> ThirtyTwoBitDuration)
-> [SigSubPacket] -> [ThirtyTwoBitDuration]
forall a b. (a -> b) -> [a] -> [b]
map (\(SigSubPacket _ (KeyExpirationTime x :: ThirtyTwoBitDuration
x)) -> ThirtyTwoBitDuration
x) ([SigSubPacket] -> [ThirtyTwoBitDuration])
-> [SigSubPacket] -> [ThirtyTwoBitDuration]
forall a b. (a -> b) -> a -> b
$ (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
forall a. (a -> Bool) -> [a] -> [a]
filter SigSubPacket -> Bool
isKET [SigSubPacket]
xs