Remove calls to head

ocheron · Aug 27, 2023 · afbbc19 · afbbc19
1 parent 94a13b4
commit afbbc19
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 7 deletions.
diff --git 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
@@ -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
@@ -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
         ]