From afbbc19a9c2f978893ffa2289b26899bb9556282 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Sun, 27 Aug 2023 15:23:44 +0200
Subject: [PATCH] Remove calls to head

---
 src/Crypto/Store/CMS/Signed.hs | 5 +++--
 src/Crypto/Store/PKCS12.hs     | 9 +++++----
 tests/X509/Tests.hs            | 2 +-
 3 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Crypto/Store/CMS/Signed.hs b/src/Crypto/Store/CMS/Signed.hs
index df14537..883b037 100644
--- a/src/Crypto/Store/CMS/Signed.hs
+++ b/src/Crypto/Store/CMS/Signed.hs
@@ -172,12 +172,13 @@ certSigner :: MonadRandom m
            -> Maybe [Attribute]
            -> [Attribute]
            -> ProducerOfSI m
-certSigner alg priv (CertificateChain chain) sAttrsM uAttrs ct msg =
+certSigner _ _ (CertificateChain []) _ _ _ _ =
+    pure $ Left (InvalidInput "Empty certificate chain")
+certSigner alg priv (CertificateChain chain@(cert:_)) sAttrsM uAttrs ct msg =
     fmap build <$> generate
   where
     md   = digest dig msg
     def  = DigestAlgorithm Crypto.Store.CMS.Algorithms.SHA256
-    cert = head chain
     obj  = signedObject (getSigned cert)
     isn  = IssuerAndSerialNumber (certIssuerDN obj) (certSerial obj)
     pub  = certPubKey obj
diff --git a/src/Crypto/Store/PKCS12.hs b/src/Crypto/Store/PKCS12.hs
index 40d3fe0..b97f538 100644
--- a/src/Crypto/Store/PKCS12.hs
+++ b/src/Crypto/Store/PKCS12.hs
@@ -670,9 +670,10 @@ fromCredential' :: ([Attribute] -> [Attribute])
                 -> ProtectionPassword
                 -> (X509.CertificateChain, X509.PrivKey)
                 -> Either StoreError PKCS12
-fromCredential' trans algChain algKey pwd (X509.CertificateChain certs, key)
-    | null certs = Left (InvalidInput "Empty certificate chain")
-    | otherwise  = (<>) <$> pkcs12Chain <*> pkcs12Key
+fromCredential' _ _ _ _ (X509.CertificateChain [], _) =
+    Left (InvalidInput "Empty certificate chain")
+fromCredential' trans algChain algKey pwd (X509.CertificateChain certs@(leaf:_), key) =
+    (<>) <$> pkcs12Chain <*> pkcs12Key
   where
     pkcs12Key   = unencrypted <$> scKeyOrError
     pkcs12Chain =
@@ -689,7 +690,7 @@ fromCredential' trans algChain algKey pwd (X509.CertificateChain certs, key)
     wrap shrouded = SafeContents [Bag (PKCS8ShroudedKeyBag shrouded) attrs]
     encodedKey    = encodeASN1Object (FormattedKey PKCS8Format key)
 
-    X509.Fingerprint keyId = X509.getFingerprint (head certs) X509.HashSHA1
+    X509.Fingerprint keyId = X509.getFingerprint leaf X509.HashSHA1
     attrs = trans (setLocalKeyId keyId [])
 
 -- Standard attributes
diff --git a/tests/X509/Tests.hs b/tests/X509/Tests.hs
index 98ff139..032426a 100644
--- a/tests/X509/Tests.hs
+++ b/tests/X509/Tests.hs
@@ -35,7 +35,7 @@ keyTests name prefix count =
               writeSignedObjectToMemory objs @?= bs
         , testCase "write public key" $ do
               bs <- B.readFile fKey
-              let key = head (readPubKeyFileFromMemory bs)
+              let (key : _) = readPubKeyFileFromMemory bs
               assertBool "first key differs" $
                   writePubKeyFileToMemory [key] `B.isPrefixOf` bs
         ]